CAS Applied Data Analytics

Thesis Data

1 Libraries

library(readr)      # load data
library(readxl)     # load Excel files
library(pxmake)     # load PX files
library(pxR)        # load PX files
library(jsonlite)   # load JSON files
library(purrr)
library(writexl)    # Write Excel files
library(flextable)  # Tables for Word
library(officer)    # Tables for Word
library(effects)
library(knitr)      # Datatable
library(ggplot2)    # Diagrams
library(ggforce)    # Diagrams
library(corrplot)   # Korrelation
library(ggcorrplot) # Korrelation / Plot
library(reshape2)
library(car)
library(e1071)
library(MASS)
library(pscl)
library(pROC)
library(GGally)     # Diagrams / Korrelation
library(plotly)     # Diagrams
library(DT)         # datatable()
library(sf)
library(leaflet)
library(leaflet.minicharts)
library(osmdata)

# am Schluss laden, u.a. select() aus dplyr greift sonst auf falsche Library
library(DescTools)
library(tidyr)
library(tidyverse)
library(dplyr)      

2 Functions

################################################  
# Duplikate in df finden & als $unique oder $duplicates selektionierbar machen
find_and_remove_duplicates <- function(df) {
  list(
    unique = df[!duplicated(df), ],
    duplicates = df[duplicated(df) | duplicated(df, fromLast = TRUE), ])}


################################################  
# Aktive National- & Ständeräte identifizieren und selektionierbar machen

filter_active <- function(data, von, bis) {
  von <- as.Date(von)
  bis <- as.Date(bis)
  data %>%
    filter(
      DateJoining <= bis,                      # Eintritt vor/am Ende d. Zeitraums
      is.na(DateLeaving) | DateLeaving >= von  # Kein Austritt/nach Beginn des Z..
    )}

3 ETL: Extract, Transform, Load

• Daten werden aus verschiedenen Excel-Dateien ausgelesen, unabhängig davon, wie komplex oder verschachtelt sie sind (z. B. mehrere Sheets, verbundene Zellen, unterteilte Datenblöcke).

• Bei Excel-Dateien mit mehreren Sheets werden Functions angewendet.

• Header werden identifiziert und ggf. aus mehreren Zeilen zusammengesetzt.

• Daten werden bereinigt, normalisiert und in das gewünschte Zielformat gebracht (z. B. Wide zu Long, Entfernen von Leerzeilen, Auflösen von verbundenen Zellen, Vereinheitlichung der Spaltenstruktur).

• Die transformierten Daten werden für die weitere Analyse und Visualisation zu Verfügung gestellt.

3.1 Lookup Tabellen

3.1.0.1 Kantone

# Dataframe bilden für Lookup der Kantonsnamen/-Kürzel
lookup_kantone <- data.frame(Kanton = c("Aargau", "Appenzell A. Rh.",
                                        "Appenzell I. Rh.", "Basel-Landschaft",
                                        "Basel-Stadt", "Bern", "Freiburg", "Genf",
                                        "Glarus", "Graubünden", "Jura", "Luzern",
                                        "Neuenburg", "Nidwalden", "Obwalden",
                                        "Schaffhausen", "Schwyz", "Solothurn",
                                        "St. Gallen", "Tessin", "Thurgau", "Uri",
                                        "Waadt", "Wallis", "Zug", "Zürich"),
                             Kt = c("AG", "AR", "AI", "BL", "BS","BE", "FR", "GE",
                                    "GL", "GR", "JU", "LU", "NE","NW", "OW", "SH",
                                    "SZ", "SO", "SG","TI", "TG", "UR", "VD", "VS",
                                    "ZG", "ZH"),
                             stringsAsFactors = FALSE)

3.1.0.2 Wahlberechtigte

# Wahlberechtigte seit 1990
Wahlberechtigte_1990_2024 <- read_excel("data/Wahlberechtigte_1990-2024.xlsx",
                                        sheet = "pivot_as_value") %>% 
  rename(year = Jahr,
         stimmberechtigte_avg_kt = Stimmberechtigte_avg)

3.1.0.3 Parteien

# Konsolidierte, bereinigte Lookup-Tabelle einlesen
lookup_parties_consolidated_raw <- read_excel("data/lookup_parties_consolidated.xlsx")

# Duplikatzeilen anzeigen (für "party_orig_value")
duplikate <- lookup_parties_consolidated_raw %>%
  group_by(party_orig_value) %>%
  filter(n() > 1) %>%
  ungroup()

# Duplikate (von Execel nicht erkannt..) entfernen
lookup_parties_consolidated <- lookup_parties_consolidated_raw %>%
  distinct(party_orig_value, .keep_all = TRUE)

3.1.0.4 Partei Ratings laden

parties_rating <- read_excel("data/parties_economic_socio-political_rating.xlsx",
                             sheet = "matrix_eco-socio_enhanced")

parties_rating_3d <- read_excel("data/parties_economic_socio-political_rating.xlsx",
                             sheet = "3d")

3.1.0.5 Geo-Koordinaten laden

ortschaftenverzeichnis <- read_delim("data/geodata/AMTOVZ_CSV_WGS84.csv",
                                     delim = ";",
                                     escape_double = FALSE,
                                     trim_ws = TRUE) 

3.2 Wahlen - Daten laden & Umformen

3.2.1 Bundesebene

3.2.1.1 Nationalrat

# Header laden
header <- as.character(read_excel("data/je-d-17.02.02.02.01.01_BUND_NATIONALRAT.xlsx",
                                  skip = 0,
                                  n_max = 1)[1, ])

# Spaltennamen "Partei 1" zu "Partei" umbenennen
header[header == "Partei 1"] <- "Partei"

# Daten ab Zeile 4 (+25) mit diesem Header einlesen
elec_nationalrat <- read_excel("data/je-d-17.02.02.02.01.01_BUND_NATIONALRAT.xlsx",
                               skip = 3,
                               n_max = 25,
                               col_names = header)

# Refernzen zu Fussnoten aus Parteispalte löschen
elec_nationalrat$Partei <- sub("\\s*\\d+$",
                               "",
                               elec_nationalrat$Partei)

3.2.1.2 Ständerat

# Header laden
header <- as.character(read_excel("data/je-d-17.02.03.01_BUND_STÄNDERAT.xlsx",
                                  skip = 0,
                                  n_max = 1)[1, ])

# Daten ab Zeile 5 (+14) mit diesem Header einlesen
elec_ständerat <- read_excel("data/je-d-17.02.03.01_BUND_STÄNDERAT.xlsx",
                              skip = 4,
                              n_max = 14,
                              col_names = header)

# Refernzen zu Fussnoten aus Parteispalte löschen
elec_ständerat$Partei <- sub("\\s*\\d+$",
                                   "",
                                   elec_ständerat$Partei)

3.2.1.3 National- & Ständerat kombinieren

# Spaltenüberschriften anschauen (unique) & Fussnoten entfernen
make.unique(colnames(elec_nationalrat))

 [1] "Partei" "1919"   "1922"   "1925"   "1928"   "1931"   "1935"   "1939 2"
 [9] "1943"   "1947"   "1951"   "1955"   "1959"   "1963"   "1967"   "1971"  
[17] "1975"   "1979"   "1983"   "1987"   "1991"   "1995"   "1999"   "2003"  
[25] "2007"   "2011"   "2015"   "2019"   "2023"  

colnames(elec_nationalrat) <- gsub(" \\d+$",
                                   "",
                                   colnames(elec_nationalrat))
make.unique(colnames(elec_nationalrat))

 [1] "Partei" "1919"   "1922"   "1925"   "1928"   "1931"   "1935"   "1939"  
 [9] "1943"   "1947"   "1951"   "1955"   "1959"   "1963"   "1967"   "1971"  
[17] "1975"   "1979"   "1983"   "1987"   "1991"   "1995"   "1999"   "2003"  
[25] "2007"   "2011"   "2015"   "2019"   "2023"  

make.unique(colnames(elec_ständerat))

 [1] "Partei" "1919"   "1922"   "1925"   "1928"   "1931"   "1935"   "1939"  
 [9] "1943"   "1947"   "1951"   "1955"   "1959"   "1963"   "1967"   "1971"  
[17] "1975"   "1979 1" "1983"   "1987"   "1991"   "1995"   "1999"   "2003"  
[25] "2007"   "2011"   "2015"   "2019"   "2023"  

colnames(elec_ständerat) <- gsub(" \\d+$",
                                 "",
                                 colnames(elec_ständerat))
make.unique(colnames(elec_ständerat))

 [1] "Partei" "1919"   "1922"   "1925"   "1928"   "1931"   "1935"   "1939"  
 [9] "1943"   "1947"   "1951"   "1955"   "1959"   "1963"   "1967"   "1971"  
[17] "1975"   "1979"   "1983"   "1987"   "1991"   "1995"   "1999"   "2003"  
[25] "2007"   "2011"   "2015"   "2019"   "2023"  

# df zusammenführen (Wide Format)
elec_nr_sr_combined_wide <- bind_rows(
  elec_nationalrat %>% mutate(role = "Nationalrat"),
  elec_ständerat %>% mutate(role = "Ständerat")) %>%
  dplyr::select(role, everything())


# df ins Long Format umwandeln
elec_nr_sr_combined_long <- elec_nr_sr_combined_wide %>%
  pivot_longer(cols = matches("^\\d{4}$"),            # Spalten mit 4 Ziffern
               names_to = "election_year",
               values_to = "n_seats") %>%
  mutate(election_year = as.integer(election_year),   # Jahr als Zahl
         n_seats = as.numeric(n_seats))               # Sitze als Zahl oder NA


current_year <- as.integer(format(Sys.Date(), "%Y"))  # aktuelles Jahr

# Zeitreihe für jede Partei/role vervollständigen und Werte fortschreiben
elec_nr_sr_combined <- elec_nr_sr_combined_long %>%
  rename(party_orig_value = Partei) %>%
  group_by(role, party_orig_value) %>%
  mutate(election_year = as.integer(election_year),   # temporär numerisch
         year = election_year) %>% 
  complete(year = seq(min(election_year,              # von min() 
                          na.rm = TRUE),
                      current_year,1),                # bis aktuelles Jahr
           fill = list(n_seats = NA,
                       election_year = NA)) %>%
  arrange(role,
          party_orig_value,
          year) %>%
  mutate(block = cumsum(!is.na(election_year))) %>% 
  # Wahljahr als Block. fill() innerhalb Block, nicht über Wahlperioden hinweg.
  group_by(role,
           party_orig_value,
           block) %>%
  fill(election_year,
       n_seats,
       .direction = "down") %>%
  ungroup() %>%
  mutate(
    election_year = as.character(election_year),      # zurück als character
    year = as.character(year)) %>%                    # dito
  select(-block)

3.2.1.4 Ergebnis National & Ständeratssitze

# Ratssitze pro Jahr
elec_nr_sr_combined_sum_check <- elec_nr_sr_combined %>%
  group_by(year, role) %>%
  summarise(total_n_seats = sum(n_seats,
                                na.rm = TRUE),
    .groups = "drop") %>%
  print()

# A tibble: 214 × 3
   year  role        total_n_seats
   <chr> <chr>               <dbl>
 1 1919  Nationalrat           189
 2 1919  Ständerat              44
 3 1920  Nationalrat           189
 4 1920  Ständerat              44
 5 1921  Nationalrat           189
 6 1921  Ständerat              44
 7 1922  Nationalrat           198
 8 1922  Ständerat              44
 9 1923  Nationalrat           198
10 1923  Ständerat              44
# ℹ 204 more rows

# National- und Ständratssitze pro Partei und Jahr
print(elec_nr_sr_combined)

# A tibble: 4,173 × 5
   role        party_orig_value year  election_year n_seats
   <chr>       <chr>            <chr> <chr>           <dbl>
 1 Nationalrat BDP              1919  1919               NA
 2 Nationalrat BDP              1920  1919               NA
 3 Nationalrat BDP              1921  1919               NA
 4 Nationalrat BDP              1922  1922               NA
 5 Nationalrat BDP              1923  1922               NA
 6 Nationalrat BDP              1924  1922               NA
 7 Nationalrat BDP              1925  1925               NA
 8 Nationalrat BDP              1926  1925               NA
 9 Nationalrat BDP              1927  1925               NA
10 Nationalrat BDP              1928  1928               NA
# ℹ 4,163 more rows

3.2.1.5 Parteinamen Bund (für Lookup-Tabelle)

unique(elec_nr_sr_combined$party_orig_value)

 [1] "BDP"       "CSP"       "CVP"       "Dem."      "Die Mitte" "EDU"      
 [7] "EVP"       "FDP"       "FGA"       "FPS"       "GLP"       "GRÜNE"    
[13] "LPS"       "LdU"       "Lega"      "MCR"       "POCH"      "PSA"      
[19] "PdA"       "Rep."      "SD"        "SP"        "SVP"       "Sol."     
[25] "Übrige"    "MCG (MCR)"

# Parteien zwecks Lookup/Vereinheitlichung mit bereinigten Namen in df schreiben
lookup_input_nr_sr_parties_label  <- elec_nr_sr_combined %>%
  select(party_orig_value) %>%
  distinct() %>%
  mutate(party_orig_value = toupper(party_orig_value),
         short_name = party_orig_value,
         short_name = if_else(short_name == "DIE MITTE",      # Umbenennen
                              "MITTE",
                              short_name),
         short_name = if_else(short_name == "MCG (MCR)",      # Umbenennen
                              "MCG",
                              short_name),
         short_name = gsub("\\.", "", short_name),            # . entfernen
         long_name = NA_character_,
         prefix = NA_character_,
         add_info = NA,
         level = NA_character_,
         source = "National_und_Ständerat") %>%
  select(party_orig_value,
         short_name,
         long_name,
         prefix,
         add_info,
         level,
         source)

# Output prüfen (unique/distinct)
lookup_input_nr_sr_parties_label %>% distinct() %>% print(n = Inf)

# A tibble: 26 × 7
   party_orig_value short_name long_name prefix add_info level source           
   <chr>            <chr>      <chr>     <chr>  <lgl>    <chr> <chr>            
 1 BDP              BDP        <NA>      <NA>   NA       <NA>  National_und_Stä…
 2 CSP              CSP        <NA>      <NA>   NA       <NA>  National_und_Stä…
 3 CVP              CVP        <NA>      <NA>   NA       <NA>  National_und_Stä…
 4 DEM.             DEM        <NA>      <NA>   NA       <NA>  National_und_Stä…
 5 DIE MITTE        MITTE      <NA>      <NA>   NA       <NA>  National_und_Stä…
 6 EDU              EDU        <NA>      <NA>   NA       <NA>  National_und_Stä…
 7 EVP              EVP        <NA>      <NA>   NA       <NA>  National_und_Stä…
 8 FDP              FDP        <NA>      <NA>   NA       <NA>  National_und_Stä…
 9 FGA              FGA        <NA>      <NA>   NA       <NA>  National_und_Stä…
10 FPS              FPS        <NA>      <NA>   NA       <NA>  National_und_Stä…
11 GLP              GLP        <NA>      <NA>   NA       <NA>  National_und_Stä…
12 GRÜNE            GRÜNE      <NA>      <NA>   NA       <NA>  National_und_Stä…
13 LPS              LPS        <NA>      <NA>   NA       <NA>  National_und_Stä…
14 LDU              LDU        <NA>      <NA>   NA       <NA>  National_und_Stä…
15 LEGA             LEGA       <NA>      <NA>   NA       <NA>  National_und_Stä…
16 MCR              MCR        <NA>      <NA>   NA       <NA>  National_und_Stä…
17 POCH             POCH       <NA>      <NA>   NA       <NA>  National_und_Stä…
18 PSA              PSA        <NA>      <NA>   NA       <NA>  National_und_Stä…
19 PDA              PDA        <NA>      <NA>   NA       <NA>  National_und_Stä…
20 REP.             REP        <NA>      <NA>   NA       <NA>  National_und_Stä…
21 SD               SD         <NA>      <NA>   NA       <NA>  National_und_Stä…
22 SP               SP         <NA>      <NA>   NA       <NA>  National_und_Stä…
23 SVP              SVP        <NA>      <NA>   NA       <NA>  National_und_Stä…
24 SOL.             SOL        <NA>      <NA>   NA       <NA>  National_und_Stä…
25 ÜBRIGE           ÜBRIGE     <NA>      <NA>   NA       <NA>  National_und_Stä…
26 MCG (MCR)        MCG        <NA>      <NA>   NA       <NA>  National_und_Stä…

3.2.2 Kantonsebene - Kantonale Regierung (Exekutive)

Die Kantonalen Abstimmungen finden nicht in allen kantonen gleichzeitg statt. Deshalb genauer die Räte/Konstellation zum Zeitpunkt der jeweiligen Abstimmung zu prüfen.

Die Struktur der “schön formatierten” Exceldatei lässt keinen “simplen” Import zu.

• 1 Excelsheet / Jahr

• Header ist in Zeile 2 und nicht vollständig

• Daten (für Kantone) starten in Zeile 4 aber enden auf Zeile 29 bevor es mit Kommentaren und Fussnoten weitergeht.

3.2.2.1 Dateipfad und gewünschte Sheets definieren

dateipfad <- "data/je-d-17.02.06.01_KANTON_Kantonale_Regierungswahlen.xlsx"  

##DATUMSFILTER##
selected_sheets <- c("2025","2024", "2023", "2022","2021","2020","2019")

3.2.2.2 Function laden

import_election_data <- function(dateipfad, sheetname) {
  
  # Headerzeilen einlesen  
  header <- readxl::read_excel(dateipfad,
                               sheet = sheetname,
                               skip = 1,
                               n_max = 0) %>%
    names()
  
  # Header anpassen: Wahljahr vereinheitlichen und Kanton hinzufügen
  header[grepl("^Wahljahr", header)] <- "Wahljahr" 
  header <- c("Kanton", header)
        
  # Daten ab Zeile 4 importieren
  daten_raw <- read_excel(dateipfad,
                          sheet = sheetname,
                          skip = 3,
                          col_names = header)
  
  # Zeilen ohne "Wahljahr" ausschliessen
  wahljahr_col <- names(daten_raw)[grepl("^Wahljahr",
                                         names(daten_raw))][1]
  names(daten_raw)[names(daten_raw) == wahljahr_col] <- "Wahljahr"

  daten_wide <- daten_raw %>%
    filter(!is.na(suppressWarnings(as.numeric(.data[[wahljahr_col]]))))
  
  # Zu pivotierenden Spalten in numeric umwandeln
  cols_pivot <- setdiff(names(daten_wide),
                        c("Kanton", wahljahr_col))
  daten_wide <- daten_wide %>%
    mutate(across(all_of(cols_pivot),
                  as.numeric))
    
  # Pivotieren
  daten_long <- daten_wide %>%
    pivot_longer(
      cols = all_of(cols_pivot),
      names_to = "Partei",
      values_to = "Wert")
  
  return(daten_long)}

3.2.2.3 Function ausführen & Konsolidation aus Datenliste

# Objekt erstellen, mit Sheets als tibble/dataframe
daten_liste <- setNames(lapply(selected_sheets,
                               function(sheet) import_election_data (dateipfad,
                                                                     sheet)),
                        selected_sheets)

str(daten_liste)

List of 7
 $ 2025: tibble [494 × 4] (S3: tbl_df/tbl/data.frame)
  ..$ Kanton  : chr [1:494] "Zürich" "Zürich" "Zürich" "Zürich" ...
  ..$ Wahljahr: num [1:494] 2023 2023 2023 2023 2023 ...
  ..$ Partei  : chr [1:494] "FDP 2" "SP" "SVP" "LP 2" ...
  ..$ Wert    : num [1:494] 1 1 2 NA 0 NA 0 1 NA NA ...
 $ 2024: tibble [494 × 4] (S3: tbl_df/tbl/data.frame)
  ..$ Kanton  : chr [1:494] "Zürich" "Zürich" "Zürich" "Zürich" ...
  ..$ Wahljahr: num [1:494] 2023 2023 2023 2023 2023 ...
  ..$ Partei  : chr [1:494] "FDP 2" "SP" "SVP" "LP 2" ...
  ..$ Wert    : num [1:494] 1 1 2 NA 0 NA 0 1 NA NA ...
 $ 2023: tibble [494 × 4] (S3: tbl_df/tbl/data.frame)
  ..$ Kanton  : chr [1:494] "Zürich" "Zürich" "Zürich" "Zürich" ...
  ..$ Wahljahr: num [1:494] 2023 2023 2023 2023 2023 ...
  ..$ Partei  : chr [1:494] "FDP 2)" "SP" "SVP" "LP 2)" ...
  ..$ Wert    : num [1:494] 1 1 2 NA 0 NA 0 1 NA NA ...
 $ 2022: tibble [494 × 4] (S3: tbl_df/tbl/data.frame)
  ..$ Kanton  : chr [1:494] "Zürich" "Zürich" "Zürich" "Zürich" ...
  ..$ Wahljahr: num [1:494] 2019 2019 2019 2019 2019 ...
  ..$ Partei  : chr [1:494] "FDP 2)" "SP" "SVP" "LP 2)" ...
  ..$ Wert    : num [1:494] 1 1 2 NA 0 NA NA NA 1 0 ...
 $ 2021: tibble [494 × 4] (S3: tbl_df/tbl/data.frame)
  ..$ Kanton  : chr [1:494] "Zürich" "Zürich" "Zürich" "Zürich" ...
  ..$ Wahljahr: num [1:494] 2019 2019 2019 2019 2019 ...
  ..$ Partei  : chr [1:494] "FDP 2)" "SP" "SVP" "LP 2)" ...
  ..$ Wert    : num [1:494] 1 1 2 NA 0 NA NA NA 1 0 ...
 $ 2020: tibble [780 × 4] (S3: tbl_df/tbl/data.frame)
  ..$ Kanton  : chr [1:780] "Zürich" "Zürich" "Zürich" "Zürich" ...
  ..$ Wahljahr: num [1:780] 2019 2019 2019 2019 2019 ...
  ..$ Partei  : chr [1:780] "FDP 2)" "CVP 3)" "SP" "SVP" ...
  ..$ Wert    : num [1:780] 1 1 1 2 NA NA NA 0 NA NA ...
 $ 2019: tibble [780 × 4] (S3: tbl_df/tbl/data.frame)
  ..$ Kanton  : chr [1:780] "Zürich" "Zürich" "Zürich" "Zürich" ...
  ..$ Wahljahr: num [1:780] 2019 2019 2019 2019 2019 ...
  ..$ Partei  : chr [1:780] "FDP 2)" "CVP 3)" "SP" "SVP" ...
  ..$ Wert    : num [1:780] 1 1 2 2 NA NA NA 0 NA NA ...

# Alle tibbles zu einem Dataframe zusammenfügen
elec_canton_combined <- bind_rows(daten_liste,
                                               .id = "year") %>%
  rename(election_year = Wahljahr,
         party_orig_value = Partei,
         n_seats = Wert) %>%
  mutate(role = "Kantonsregierung",
         election_year = as.character(election_year)) %>% 
  filter(party_orig_value != "Total") %>%
  left_join(lookup_kantone, by = "Kanton") %>%
  select(role,
         party_orig_value,
         year,
         election_year,
         n_seats,
         Kt,
         Kanton,
         everything())

3.2.2.4 Ergebnis Kantonsregierung

# Ratssitze pro Jahr (nach-)prüfen
elec_canton_combined_sum_check <- elec_canton_combined %>%
  group_by(year, role) %>%
  summarise(total_n_seats = sum(n_seats,
                                na.rm = TRUE),
    .groups = "drop") %>%
  print(n=Inf)

# A tibble: 7 × 3
  year  role             total_n_seats
  <chr> <chr>                    <dbl>
1 2019  Kantonsregierung           154
2 2020  Kantonsregierung           154
3 2021  Kantonsregierung           154
4 2022  Kantonsregierung           154
5 2023  Kantonsregierung           154
6 2024  Kantonsregierung           154
7 2025  Kantonsregierung           154

# National- und Ständratssitze pro Partei und Jahr
print(elec_canton_combined)

# A tibble: 3,848 × 7
   role             party_orig_value year  election_year n_seats Kt    Kanton
   <chr>            <chr>            <chr> <chr>           <dbl> <chr> <chr> 
 1 Kantonsregierung FDP 2            2025  2023                1 ZH    Zürich
 2 Kantonsregierung SP               2025  2023                1 ZH    Zürich
 3 Kantonsregierung SVP              2025  2023                2 ZH    Zürich
 4 Kantonsregierung LP 2             2025  2023               NA ZH    Zürich
 5 Kantonsregierung EVP              2025  2023                0 ZH    Zürich
 6 Kantonsregierung CSP              2025  2023               NA ZH    Zürich
 7 Kantonsregierung GLP              2025  2023                0 ZH    Zürich
 8 Kantonsregierung Die Mitte 3      2025  2023                1 ZH    Zürich
 9 Kantonsregierung CVP 3            2025  2023               NA ZH    Zürich
10 Kantonsregierung BDP 3            2025  2023               NA ZH    Zürich
# ℹ 3,838 more rows

3.2.2.5 Parteinamen Kanton (für Lookup-Tabelle)

#| label: output_canton_parties

# Parteinamenvarianten
unique(elec_canton_combined$party_orig_value)

 [1] "FDP 2"        "SP"           "SVP"          "LP 2"         "EVP"         
 [6] "CSP"          "GLP"          "Die Mitte 3"  "CVP 3"        "BDP 3"       
[11] "PdA"          "PSA"          "Grüne 5"      "FGA"          "Sol."        
[16] "Lega"         "MCG (MCR)"    "Übrige 4"     "FDP 2)"       "LP 2)"       
[21] "Die Mitte 3)" "CVP 3)"       "BDP 5)"       "Grüne 6)"     "MCR"         
[26] "Übrige 4)"    "GPS"          "Dem."         "LdU"          "DSP"         
[31] "BDP"          "POCH"         "SD"           "Rep."         "EDU"         
[36] "FPS"          "LS"           "JB"           "Front"        "Grüt"        
[41] "GP"          

# Parteien zwecks Lookup/Vereinheitlichung mit bereinigten Namen in df schreiben
lookup_input_canton_parties_label <- elec_canton_combined %>%
  mutate(level = NA_character_,
         long_name = NA_character_,
         source = "Kantonale_Regierung",
         
         add_info = str_extract(party_orig_value,
                                "\\d+(?=\\)?$)"),  # Zahl am Ende/vor Klammer-Ende
         short_name = str_remove(party_orig_value,
                                 "\\s*\\d+\\)?$"), # - Leerzeichen/Zahl/Klammer
         prefix = NA_character_) %>%
  select(party_orig_value,
         short_name,
         long_name,
         prefix,
         add_info,
         level,
         source) %>%
  # Großschreibung der short_name-Spalte
  mutate(short_name = toupper(short_name)) 
 
# Output prüfen (unique/distinct)
lookup_input_canton_parties_label %>% distinct() %>% print(n = Inf)

# A tibble: 41 × 7
   party_orig_value short_name long_name prefix add_info level source           
   <chr>            <chr>      <chr>     <chr>  <chr>    <chr> <chr>            
 1 FDP 2            FDP        <NA>      <NA>   2        <NA>  Kantonale_Regier…
 2 SP               SP         <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
 3 SVP              SVP        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
 4 LP 2             LP         <NA>      <NA>   2        <NA>  Kantonale_Regier…
 5 EVP              EVP        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
 6 CSP              CSP        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
 7 GLP              GLP        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
 8 Die Mitte 3      DIE MITTE  <NA>      <NA>   3        <NA>  Kantonale_Regier…
 9 CVP 3            CVP        <NA>      <NA>   3        <NA>  Kantonale_Regier…
10 BDP 3            BDP        <NA>      <NA>   3        <NA>  Kantonale_Regier…
11 PdA              PDA        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
12 PSA              PSA        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
13 Grüne 5          GRÜNE      <NA>      <NA>   5        <NA>  Kantonale_Regier…
14 FGA              FGA        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
15 Sol.             SOL.       <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
16 Lega             LEGA       <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
17 MCG (MCR)        MCG (MCR)  <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
18 Übrige 4         ÜBRIGE     <NA>      <NA>   4        <NA>  Kantonale_Regier…
19 FDP 2)           FDP        <NA>      <NA>   2        <NA>  Kantonale_Regier…
20 LP 2)            LP         <NA>      <NA>   2        <NA>  Kantonale_Regier…
21 Die Mitte 3)     DIE MITTE  <NA>      <NA>   3        <NA>  Kantonale_Regier…
22 CVP 3)           CVP        <NA>      <NA>   3        <NA>  Kantonale_Regier…
23 BDP 5)           BDP        <NA>      <NA>   5        <NA>  Kantonale_Regier…
24 Grüne 6)         GRÜNE      <NA>      <NA>   6        <NA>  Kantonale_Regier…
25 MCR              MCR        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
26 Übrige 4)        ÜBRIGE     <NA>      <NA>   4        <NA>  Kantonale_Regier…
27 GPS              GPS        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
28 Dem.             DEM.       <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
29 LdU              LDU        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
30 DSP              DSP        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
31 BDP              BDP        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
32 POCH             POCH       <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
33 SD               SD         <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
34 Rep.             REP.       <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
35 EDU              EDU        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
36 FPS              FPS        <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
37 LS               LS         <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
38 JB               JB         <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
39 Front            FRONT      <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
40 Grüt             GRÜT       <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…
41 GP               GP         <NA>      <NA>   <NA>     <NA>  Kantonale_Regier…

3.2.3 Gemeindeebene - Exekutiven der statistischen Städte

• 1 Excelsheet / Jahr

• Header zweizeilig mit Start in Zeile –> 3 skip = 2, n_max = 2,

• Teils verbundene Header-Zeilen (vertikal/horizontal)

• Cluster Einwohnerzahlen unterteilt Daten

• Parteinamen uneinheitlich aufgrund von Fussnoten

–> Datenformat “wide” zuerst bereinigen und ins “long” Format bringen

3.2.3.1 Dateipfad und gewünschte Sheets festlegen

dateipfad <- "data/je-d-17.02.07.01_GEMEINDE_Die Exekutiven der statistischen Städte.xlsx"

##DATUMSFILTER##
selected_sheets <- c("2024", "2023", "2022","2021","2020","2019") 

3.2.3.2 Function für den Import der Gemeindedaten

importiere_sheet <- function(dateipfad, sheetname) {

      ########## HEADER ##########################################
      ########## Auslesen/Zusammensetzen ################################
    
        # Headerzeilen einlesen
      header <- suppressMessages(read_excel(dateipfad,
                   sheet = sheetname,
                   skip = 2,
                   n_max = 2,
                   col_names = FALSE))
      
      # Daten  einlesen
      daten_raw <- suppressMessages(read_excel(dateipfad,
                              sheet = sheetname,
                              skip = 5,
                              col_names = FALSE))
      
      # Spaltennamen zusammensetzen
      # Leere Zellen in 1. Headerzeile mit Werten von rechts auffüllen wenn leer/NA
      header_filled <- as.data.frame(t(header))   # t() "matrix transpose"
      header_filled <- fill(header_filled,        
                            V1,                   # Header Spalte 1 (V1) auffüllen
                            .direction = "down")  # Werte nach unten übernehmen
      header_filled <- t(header_filled)           # t() nochmals (zurück)
      
      # Spaltennamen kombinieren
      spaltennamen <- paste(header_filled[1, ],
                            header_filled[2, ],
                            sep = "_")
      spaltennamen <- gsub("_NA|NA_","", spaltennamen) # Entfernt überflüssige NAs
      
      # Spaltennamen zuweisen
      colnames(daten_raw) <- spaltennamen
      
      
      ########## TRANSPONIEREN ##########################################
      ########## Gemeindegrössen Cluster ################################
    
      # Cluster Einwohnerzahl als Spalte verwenden
      daten_wide <- daten_raw %>%
        mutate(Gemeindegrösse_Cluster =             # Name der neuen Spalte
                 ifelse(
                   is.na(                           # 4) auf NA prüfen
                     suppressWarnings(        # 3) Warnung aus (z.B. "≥ ..Einw..")
                     as.numeric(                    # 2) Wert als Zahl 
                     gsub("'", "", `Kantons-Nr.`)   # 1) Tausender Zeichen (')                                                              entfernen
                   ))),
                   as.character(`Kantons-Nr.`),     # 5) Wert von "Kantons-Nr" 
                   NA_character_                    #    sonst NA   
                 ))  %>%
        fill(Gemeindegrösse_Cluster,
             .direction = "down") %>%              # Cluster nach unten auffüllen
        filter(!is.na(suppressWarnings(
          as.numeric(gsub("'", "", `Kantons-Nr.`))))) # Herausfiltern von Zeilen                                                           mit NICHT-numerischem Wert

    # Ansicht (Snapshot) nach transponieren
    daten_wide[1:10,                    # 10 Zeilen
               c(1:10,                  # 10 Spalten +
                 ncol(daten_wide))]     # Letzte Spalte
                                        # ncol() von df daten_wide --> Anz. Spalten
                                        # Anzahl Spalten = Position letzte Spalte
    
    
    ########## TRANSPONIEREN ##########################################
    ########## Frauen, Männer, Total & Parteien ## ####################
    
    daten_long <- daten_wide %>%
      mutate(across(matches("(_Frauen|_Männer|_Total)$"),
                    ~ suppressWarnings(as.numeric(.)))) %>%       # Werte numerisch
      pivot_longer(cols = matches("(_Frauen|_Männer|_Total)$"),   # Spaltenauswahl
                   names_to = c("party_orig_value", "m_w_Total"),  # Label-Spalte
                   names_pattern = "^(.*)_(Frauen|Männer|Total)$",# RegEx
                   values_to = "Wert")                            # Wert-Spalte
    
    return(daten_long)}

3.2.3.3 Import der Dateien testen (optional)

for (sheet in selected_sheets) {
  cat("\n-----------------------------\n")
  cat("Versuche Sheet:", sheet, "\n")
  result <- tryCatch({
    dat <- importiere_sheet(dateipfad, sheet)
    cat("Sheet erfolgreich eingelesen:", sheet, "\n")
    # Zusammenfassung:
    cat("Anzahl Zeilen:", nrow(dat), "\n")
    cat("Anzahl Spalten:", ncol(dat), "\n")
    cat("Spaltennamen (erste 15):", paste(names(dat)[1:min(15, ncol(dat))], collapse = ", "), "\n")
    TRUE
  }, error = function(e) {
    cat("Fehler beim Einlesen von Sheet:", sheet, "\n")
    cat("Fehlermeldung:", e$message, "\n")
    FALSE
  })}

-----------------------------
Versuche Sheet: 2024 
Sheet erfolgreich eingelesen: 2024 
Anzahl Zeilen: 7515 
Anzahl Spalten: 10 
Spaltennamen (erste 15): Kantons-Nr., Kanton, Gemeinde-Nr., Gemeinde, Wahljahr, Einwohner, Gemeindegrösse_Cluster, party_orig_value, m_w_Total, Wert 

-----------------------------
Versuche Sheet: 2023 
Sheet erfolgreich eingelesen: 2023 
Anzahl Zeilen: 7776 
Anzahl Spalten: 10 
Spaltennamen (erste 15): Kantons-Nr., Kanton, Gemeinde-Nr., Gemeinde, Wahljahr, Einwohner, Gemeindegrösse_Cluster, party_orig_value, m_w_Total, Wert 

-----------------------------
Versuche Sheet: 2022 
Sheet erfolgreich eingelesen: 2022 
Anzahl Zeilen: 7776 
Anzahl Spalten: 10 
Spaltennamen (erste 15): Kantons-Nr., Kanton, Gemeinde-Nr., Gemeinde, Wahljahr, Einwohner, Gemeindegrösse_Cluster, party_orig_value, m_w_Total, Wert 

-----------------------------
Versuche Sheet: 2021 
Sheet erfolgreich eingelesen: 2021 
Anzahl Zeilen: 7776 
Anzahl Spalten: 10 
Spaltennamen (erste 15): Kantons-Nr., Kanton, Gemeinde-Nr., Gemeinde, Wahljahr, Einwohner, Gemeindegrösse_Cluster, party_orig_value, m_w_Total, Wert 

-----------------------------
Versuche Sheet: 2020 
Sheet erfolgreich eingelesen: 2020 
Anzahl Zeilen: 7290 
Anzahl Spalten: 10 
Spaltennamen (erste 15): Kantons-Nr., Kanton, Gemeinde-Nr., Gemeinde, Wahljahr, Einwohner, Gemeindegrösse_Cluster, party_orig_value, m_w_Total, Wert 

-----------------------------
Versuche Sheet: 2019 
Sheet erfolgreich eingelesen: 2019 
Anzahl Zeilen: 14580 
Anzahl Spalten: 11 
Spaltennamen (erste 15): Kantons-Nr., Kanton, Gemeinde-Nr., Gemeinde, Einwohner, Grössenklasse-Nr., Grössenklasse, Gemeindegrösse_Cluster, party_orig_value, m_w_Total, Wert 

3.2.3.4 Function ausführen & Konsolidation aus Datenliste

# Objekt erstellen, mit Sheets als tibble/dataframe
daten_liste <- setNames(lapply(selected_sheets,
                               function(sheet) importiere_sheet(dateipfad, sheet)),
                        selected_sheets)

str(daten_liste)

List of 6
 $ 2024: tibble [7,515 × 10] (S3: tbl_df/tbl/data.frame)
  ..$ Kantons-Nr.           : chr [1:7515] "1" "1" "1" "1" ...
  ..$ Kanton                : chr [1:7515] "ZH" "ZH" "ZH" "ZH" ...
  ..$ Gemeinde-Nr.          : num [1:7515] 230 230 230 230 230 230 230 230 230 230 ...
  ..$ Gemeinde              : chr [1:7515] "Winterthur" "Winterthur" "Winterthur" "Winterthur" ...
  ..$ Wahljahr              : num [1:7515] 2022 2022 2022 2022 2022 ...
  ..$ Einwohner             : num [1:7515] 115129 115129 115129 115129 115129 ...
  ..$ Gemeindegrösse_Cluster: chr [1:7515] "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" ...
  ..$ party_orig_value      : chr [1:7515] "FDP 1" "FDP 1" "FDP 1" "Die Mitte 2" ...
  ..$ m_w_Total             : chr [1:7515] "Frauen" "Männer" "Total" "Frauen" ...
  ..$ Wert                  : num [1:7515] 0 1 1 0 1 1 NA NA NA 1 ...
 $ 2023: tibble [7,776 × 10] (S3: tbl_df/tbl/data.frame)
  ..$ Kantons-Nr.           : chr [1:7776] "1" "1" "1" "1" ...
  ..$ Kanton                : chr [1:7776] "ZH" "ZH" "ZH" "ZH" ...
  ..$ Gemeinde-Nr.          : num [1:7776] 230 230 230 230 230 230 230 230 230 230 ...
  ..$ Gemeinde              : chr [1:7776] "Winterthur" "Winterthur" "Winterthur" "Winterthur" ...
  ..$ Wahljahr              : num [1:7776] 2022 2022 2022 2022 2022 ...
  ..$ Einwohner             : num [1:7776] 115129 115129 115129 115129 115129 ...
  ..$ Gemeindegrösse_Cluster: chr [1:7776] "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" ...
  ..$ party_orig_value      : chr [1:7776] "FDP 1" "FDP 1" "FDP 1" "Die Mitte 2" ...
  ..$ m_w_Total             : chr [1:7776] "Frauen" "Männer" "Total" "Frauen" ...
  ..$ Wert                  : num [1:7776] 0 1 1 0 1 1 NA NA NA 1 ...
 $ 2022: tibble [7,776 × 10] (S3: tbl_df/tbl/data.frame)
  ..$ Kantons-Nr.           : chr [1:7776] "1" "1" "1" "1" ...
  ..$ Kanton                : chr [1:7776] "ZH" "ZH" "ZH" "ZH" ...
  ..$ Gemeinde-Nr.          : num [1:7776] 230 230 230 230 230 230 230 230 230 230 ...
  ..$ Gemeinde              : chr [1:7776] "Winterthur" "Winterthur" "Winterthur" "Winterthur" ...
  ..$ Wahljahr              : num [1:7776] 2022 2022 2022 2022 2022 ...
  ..$ Einwohner             : num [1:7776] 115129 115129 115129 115129 115129 ...
  ..$ Gemeindegrösse_Cluster: chr [1:7776] "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" ...
  ..$ party_orig_value      : chr [1:7776] "FDP 1" "FDP 1" "FDP 1" "Die Mitte 2" ...
  ..$ m_w_Total             : chr [1:7776] "Frauen" "Männer" "Total" "Frauen" ...
  ..$ Wert                  : num [1:7776] 0 1 1 0 1 1 NA NA NA 1 ...
 $ 2021: tibble [7,776 × 10] (S3: tbl_df/tbl/data.frame)
  ..$ Kantons-Nr.           : chr [1:7776] "1" "1" "1" "1" ...
  ..$ Kanton                : chr [1:7776] "ZH" "ZH" "ZH" "ZH" ...
  ..$ Gemeinde-Nr.          : num [1:7776] 230 230 230 230 230 230 230 230 230 230 ...
  ..$ Gemeinde              : chr [1:7776] "Winterthur" "Winterthur" "Winterthur" "Winterthur" ...
  ..$ Wahljahr              : num [1:7776] 2018 2018 2018 2018 2018 ...
  ..$ Einwohner             : num [1:7776] 110912 110912 110912 110912 110912 ...
  ..$ Gemeindegrösse_Cluster: chr [1:7776] "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" ...
  ..$ party_orig_value      : chr [1:7776] "FDP 1" "FDP 1" "FDP 1" "Die Mitte 2" ...
  ..$ m_w_Total             : chr [1:7776] "Frauen" "Männer" "Total" "Frauen" ...
  ..$ Wert                  : num [1:7776] 1 1 2 NA NA NA 0 1 1 2 ...
 $ 2020: tibble [7,290 × 10] (S3: tbl_df/tbl/data.frame)
  ..$ Kantons-Nr.           : chr [1:7290] "1" "1" "1" "1" ...
  ..$ Kanton                : chr [1:7290] "ZH" "ZH" "ZH" "ZH" ...
  ..$ Gemeinde-Nr.          : num [1:7290] 230 230 230 230 230 230 230 230 230 230 ...
  ..$ Gemeinde              : chr [1:7290] "Winterthur" "Winterthur" "Winterthur" "Winterthur" ...
  ..$ Wahljahr              : num [1:7290] 2018 2018 2018 2018 2018 ...
  ..$ Einwohner             : num [1:7290] 110912 110912 110912 110912 110912 ...
  ..$ Gemeindegrösse_Cluster: chr [1:7290] "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" ...
  ..$ party_orig_value      : chr [1:7290] "FDP 1)" "FDP 1)" "FDP 1)" "CVP" ...
  ..$ m_w_Total             : chr [1:7290] "Frauen" "Männer" "Total" "Frauen" ...
  ..$ Wert                  : num [1:7290] 1 1 2 0 1 1 2 1 3 NA ...
 $ 2019: tibble [14,580 × 11] (S3: tbl_df/tbl/data.frame)
  ..$ Kantons-Nr.           : chr [1:14580] "1" "1" "1" "1" ...
  ..$ Kanton                : chr [1:14580] "ZH" "ZH" "ZH" "ZH" ...
  ..$ Gemeinde-Nr.          : num [1:14580] 230 230 230 230 230 230 230 230 230 230 ...
  ..$ Gemeinde              : chr [1:14580] "Winterthur" "Winterthur" "Winterthur" "Winterthur" ...
  ..$ Einwohner             : num [1:14580] 111851 111851 111851 111851 111851 ...
  ..$ Grössenklasse-Nr.     : chr [1:14580] "4" "4" "4" "4" ...
  ..$ Grössenklasse         : chr [1:14580] "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" ...
  ..$ Gemeindegrösse_Cluster: chr [1:14580] "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" "≥ 100'000 Einwohnerinnen und Einwohner" ...
  ..$ party_orig_value      : chr [1:14580] "FDP 1)" "FDP 1)" "FDP 1)" "CVP" ...
  ..$ m_w_Total             : chr [1:14580] "Frauen" "Männer" "Total" "Frauen" ...
  ..$ Wert                  : num [1:14580] 1 1 2 0 1 1 2 1 3 NA ...

# lapply(daten_liste, summary)

# Alle tibbles zu einem Dataframe zusammenfügen
elec_gemeinde_combined <- bind_rows(daten_liste,
                                            .id = "year") %>% 
  filter(m_w_Total == "Total",
         party_orig_value != "Total") %>% 
  rename(election_year = Wahljahr,
         n_seats = Wert,
         Kt = Kanton) %>% 
  mutate(role = "Gemeindeexekutive",
         election_year = as.character(election_year)) %>%
  select(-c('Grössenklasse-Nr.',
            Grössenklasse,
            `Kantons-Nr.`,
            m_w_Total)) %>%
  left_join(lookup_kantone, by = "Kt") %>%
  select(role,
         party_orig_value,
         year,
         election_year,
         n_seats,
         Kt,
         Kanton,
         everything())


#  year in integer umwandeln
elec_gemeinde_combined$year <- as.integer(as.character(elec_gemeinde_combined$year))

# Fehlende Jahre ergänzen
current_year <- as.integer(format(Sys.Date(), "%Y"))
max_year <- max(elec_gemeinde_combined$year, na.rm = TRUE)

if (max_year < current_year) {
  # Für jedes fehlende Jahr
  for (y in (max_year+1):current_year) {
    # Letzte Werte kopieren und Jahr anpassen
    last_year_data <- elec_gemeinde_combined %>% filter(year == max_year)
    last_year_data$year <- y
    last_year_data$election_year <- as.character(y)
    elec_gemeinde_combined <- bind_rows(elec_gemeinde_combined, last_year_data)
  }}

3.2.3.5 Ergebnis Gemeinde bzw. Exekutiven statistischer Städte

# Ratssitze pro Jahr (nach-)prüfen
elec_gemeinde_combined_sum_check <- elec_gemeinde_combined %>%
  group_by(year) %>%                         # Gruppieren nach Jahr
  summarise(summe = sum(n_seats, na.rm = TRUE)) # Summe berechnen, NAs ignorieren

# Grosses Datatable, deshalb auskommentiert
# datatable(elec_gemeinde_exekutiven_combined,
#           class = 'nowrap',
#           filter = 'top',
#           options = list(pageLength = 7,
#                          scrollX = TRUE,
#                          search = list(regex = TRUE,
#                                        caseInsensitive = TRUE)))

3.2.3.6 Parteinamen Gemeinde (für Lookup-Tabelle)

# Parteinamenvarianten
unique(elec_gemeinde_combined$party_orig_value)

 [1] "FDP 1"       "Die Mitte 2" "CVP 2"       "SP"          "SVP"        
 [6] "LP 1"        "EVP"         "CSP"         "GLP"         "PdA"        
[11] "GRÜNE 3"     "EDU"         "Lega"        "Übrige"      "BDP 2"      
[16] "FDP 1)"      "CVP"         "LP 1)"       "BDP"         "GPS"        
[21] "Dem."        "LdU"         "DSP"         "PSA"         "POCH"       
[26] "GA"          "Sol."        "SD"          "Rep."        "FPS"        
[31] "MCR"         "LS"          "JB"          "Front"       "Grüt"       

# Parteien zwecks Lookup/Vereinheitlichung mit bereinigten Namen in df schreiben
lookup_input_gemeinde_parties_label <- elec_gemeinde_combined %>%
  mutate(add_info = str_extract(party_orig_value,
                                "\\d+(?=\\)?$)"),  # Zahl am Ende/vor Klammer-Ende
         short_name = str_remove(party_orig_value,
                                 "\\s*\\d+\\)?$"), # - Leerzeichen/Zahl/Klammer
         long_name = NA_character_, 
         prefix = NA_character_,
         level = NA_character_,
         source = "Gemeinde_Exekutiven") %>% 
  # Großschreibung der short_name-Spalte
  mutate(short_name = toupper(short_name))%>% 
  select(party_orig_value,
         short_name,
         long_name,
         prefix,
         add_info,
         level,
         source)
  
# Output prüfen (unique/distinct)
lookup_input_gemeinde_parties_label %>% distinct() %>% print(n = Inf)

# A tibble: 35 × 7
   party_orig_value short_name long_name prefix add_info level source           
   <chr>            <chr>      <chr>     <chr>  <chr>    <chr> <chr>            
 1 FDP 1            FDP        <NA>      <NA>   1        <NA>  Gemeinde_Exekuti…
 2 Die Mitte 2      DIE MITTE  <NA>      <NA>   2        <NA>  Gemeinde_Exekuti…
 3 CVP 2            CVP        <NA>      <NA>   2        <NA>  Gemeinde_Exekuti…
 4 SP               SP         <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
 5 SVP              SVP        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
 6 LP 1             LP         <NA>      <NA>   1        <NA>  Gemeinde_Exekuti…
 7 EVP              EVP        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
 8 CSP              CSP        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
 9 GLP              GLP        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
10 PdA              PDA        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
11 GRÜNE 3          GRÜNE      <NA>      <NA>   3        <NA>  Gemeinde_Exekuti…
12 EDU              EDU        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
13 Lega             LEGA       <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
14 Übrige           ÜBRIGE     <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
15 BDP 2            BDP        <NA>      <NA>   2        <NA>  Gemeinde_Exekuti…
16 FDP 1)           FDP        <NA>      <NA>   1        <NA>  Gemeinde_Exekuti…
17 CVP              CVP        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
18 LP 1)            LP         <NA>      <NA>   1        <NA>  Gemeinde_Exekuti…
19 BDP              BDP        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
20 GPS              GPS        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
21 Dem.             DEM.       <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
22 LdU              LDU        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
23 DSP              DSP        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
24 PSA              PSA        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
25 POCH             POCH       <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
26 GA               GA         <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
27 Sol.             SOL.       <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
28 SD               SD         <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
29 Rep.             REP.       <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
30 FPS              FPS        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
31 MCR              MCR        <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
32 LS               LS         <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
33 JB               JB         <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
34 Front            FRONT      <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…
35 Grüt             GRÜT       <NA>      <NA>   <NA>     <NA>  Gemeinde_Exekuti…

3.2.4 Listen aller Staatsebenen konsolidieren & einheitliche Parteinamen joinen

# In allen Dataframes die year-Spalte vereinheitlichen
elec_nr_sr_combined$year <- as.integer(as.character(elec_nr_sr_combined$year))
elec_canton_combined$year <- as.integer(as.character(elec_canton_combined$year))
elec_gemeinde_combined$year <- as.integer(as.character(elec_gemeinde_combined$year))


lookup_parties_consolidated %>%
  dplyr::count(party_orig_value) %>%
  filter(n > 1)

# A tibble: 0 × 2
# ℹ 2 variables: party_orig_value <chr>, n <int>

lookup_parties_consolidated %>%
  distinct(party_orig_value, .keep_all = TRUE)

# A tibble: 561 × 9
   Partei Parteiname party_orig_value short_name long_name prefix add_info level
   <chr>  <chr>      <chr>            <chr>      <lgl>     <chr>  <chr>    <chr>
 1 OTHERS Andere (S… p-others_counte… OTHERS     NA        p      counterp state
 2 OTHERS Andere (S… p-others_counte… OTHERS     NA        p      counter… state
 3 OTHERS Andere (S… p-others_free    OTHERS     NA        p      free     state
 4 OTHERS Andere (S… p-others_free-fr OTHERS     NA        p      free-fr  state
 5 OTHERS Andere (S… p-others_init    OTHERS     NA        p      init     state
 6 OTHERS Andere (S… p-others_init-fr OTHERS     NA        p      init-fr  state
 7 OTHERS Andere (S… p-others_no      OTHERS     NA        p      no       state
 8 OTHERS Andere (S… p-others_no-fr   OTHERS     NA        p      no-fr    state
 9 OTHERS Andere (S… p-others_yes     OTHERS     NA        p      yes      state
10 OTHERS Andere (S… p-others_yes-fr  OTHERS     NA        p      yes-fr   state
# ℹ 551 more rows
# ℹ 1 more variable: source <chr>

#write_xlsx(elec_all_combined,"tmp_elec_all_combined.xlsx")

# Vereinheitlichte Dataframes (Exekutiven je Staatsebene) konsolidieren
elec_all_combined <- bind_rows(elec_nr_sr_combined,
                               elec_canton_combined,
                               elec_gemeinde_combined) %>%
  # Lookup für einheiltiche Parteinamen anwenden
  left_join(lookup_parties_consolidated %>%
              select(Partei,
                     Parteiname,
                     party_orig_value),
            by = "party_orig_value",
            relationship = "many-to-many") %>%
  relocate(Partei,
           Parteiname,
           .after = party_orig_value)

3.2.5 Clean-up “Election”: Obsolete Objekte (nach Konsolidierung) löschen

# Clean-up: Nicht mehr benötigte "election" Tabellen löschen
 rm(list = ls(pattern = "^elec_")[       # Objekte die mit elec_ starten aber nicht
   !grepl("(_all_final|_combined|_combined_sum_check)$", # auf all_combined oder all_final enden
          ls(pattern = "^elec_"))])

3.2.6 Parteistärken berechnen - Sitze aggregiert auf Staatsebene

3.2.6.1 Jahre eingrenzen

##DATUMSFILTER##
# Jahre eingrenzen
elec_all_combined_input <-  elec_all_combined %>% 
  filter(year >= "2019")

3.2.6.2 Dataframes vereinheitlichen und ggfs. aggregieren

3.2.6.2.1 Staatsebene: National- und Ständerat “as is”

elec_nr_sr_lvl_state <- elec_all_combined_input %>%
  filter(role %in% c("Ständerat",
                     "Nationalrat")) %>%
  group_by(year,
           Partei) %>%
  summarise(n_seats_sum = sum(n_seats,
                              na.rm = TRUE),
            .groups = "drop") %>%
  group_by(year) %>%
  mutate(n_seats_pct = 100 * n_seats_sum / sum(n_seats_sum, na.rm = TRUE)) %>%
  ungroup() %>%
  filter(n_seats_sum > 0)

3.2.6.2.2 Kantonsebene: Gewichtung nach Stimmberechtigten je Kanton für Aggregation auf Staatsebene

# aggregiert auf Kantonsebene
elec_kanton_lvl_kt <- elec_all_combined_input %>%
  filter(role == "Kantonsregierung") %>%
  group_by(year,
           Kt,
           Partei) %>%
  summarise(n_seats_sum = sum(n_seats,
                              na.rm = TRUE),
            .groups = "drop") %>%
  group_by(year,
           Kt) %>%
  mutate(n_seats_pct = 100 * n_seats_sum / sum(n_seats_sum,
                                               na.rm = TRUE)) %>%
  ungroup()


# integer vs. character --> anpassen
Wahlberechtigte_1990_2024 <- Wahlberechtigte_1990_2024 %>%
  mutate(year = as.integer(as.character(year)))

# aggregiert auf Staatsebene
elec_kanton_lvl_state <- elec_all_combined_input %>%
  filter(role == "Kantonsregierung") %>%
  left_join(Wahlberechtigte_1990_2024 %>%
              group_by(year) %>% 
              summarise(stimmberechtigte_avg_state = sum(stimmberechtigte_avg_kt,
                                                         na.rm = TRUE)),
    by = "year") %>%
  mutate(n_seats_weighted = n_seats * stimmberechtigte_avg_state) %>%
  group_by(year,
           Partei) %>%
  summarise(n_seats_sum = sum(n_seats,
                              na.rm = TRUE),
            n_seats_sum_weighted = sum(n_seats_weighted,
                                       na.rm = TRUE),
            stimmberechtigte_avg_state = first(stimmberechtigte_avg_state),
            .groups = "drop") %>%
  group_by(year) %>%
  mutate(n_seats_pct =
           100 * n_seats_sum / sum(n_seats_sum,
                                   na.rm = TRUE),
         n_seats_pct_weighted =
           100 * n_seats_sum_weighted / sum(n_seats_sum_weighted,
                                            na.rm = TRUE)) %>%
  ungroup()

3.2.6.2.3 Gemeindeebene: Gewichtung nach Einwohner je “statistische Stadt” aggregiert auf Kanton- und Staatsebene

# aggregiert auf Gemeindeebene
elec_gemeinde_lvl_gemeinde  <- elec_all_combined_input %>%
  filter(role == "Gemeindeexekutive",
         n_seats != 0) %>%
  group_by(year,
           Gemeinde,
           Partei) %>%
  summarise(n_seats_sum = sum(n_seats,
                              na.rm = TRUE),
            .groups = "drop") %>%
  group_by(year,
           Gemeinde) %>%
  mutate(n_seats_pct = 100* n_seats_sum / sum(n_seats_sum,
                                         na.rm = TRUE)) %>%
  ungroup()

# aggregiert auf Kantonsebene
elec_gemeinde_lvl_kt <- elec_all_combined_input %>%
  filter(role == "Gemeindeexekutive",
         n_seats != 0) %>%
  group_by(year,
           Kt,
           Gemeinde,
           Partei) %>%
  summarise(n_seats_sum = sum(n_seats, na.rm = TRUE),
            Einwohner = first(Einwohner),
            .groups = "drop") %>%
  mutate(weighted_seats = n_seats_sum * Einwohner) %>%
  group_by(year,
           Kt,
           Partei) %>%
  summarise(n_seats_sum = sum(n_seats_sum,                  # ungewichtete Sitze
                              na.rm = TRUE),
            n_seats_sum_weighted = sum(weighted_seats,      # gewichtete Sitze
                                     na.rm = TRUE), 
            .groups = "drop") %>%
  group_by(year,
           Kt) %>%
  mutate(n_seats_pct = 100 *                                # ungewichtet %
           n_seats_sum / sum(n_seats_sum,
                             na.rm = TRUE),
         n_seats_pct_weighted = 100 *                       # gewichtet %  
           n_seats_sum_weighted / sum(n_seats_sum_weighted,
                                    na.rm = TRUE)) %>%
  ungroup()

# aggregiert auf Staatsebene 
elec_gemeinde_lvl_state <- elec_all_combined_input %>%
  filter(role == "Gemeindeexekutive",
         n_seats != 0) %>%
  group_by(year,
           Gemeinde,
           Partei) %>%
  summarise(n_seats_sum = sum(n_seats,
                              na.rm = TRUE),
            Einwohner = first(Einwohner),
            .groups = "drop") %>%
  mutate(weighted_seats = n_seats_sum * Einwohner) %>%
  group_by(year,
           Partei) %>%
  summarise(n_seats_sum = sum(n_seats_sum,                   # ungewichtete Sitze
                              na.rm = TRUE),
            n_seats_sum_weighted = sum(weighted_seats,       # gewichtete Sitze
                                       na.rm = TRUE),
            .groups = "drop") %>%
  group_by(year) %>%
  mutate(n_seats_pct = 100 *
           n_seats_sum / sum(n_seats_sum,
                             na.rm = TRUE),                  # ungewichtet %
         n_seats_pct_weighted = 100 *
           n_seats_sum_weighted / sum(n_seats_sum_weighted,
                                      na.rm = TRUE)) %>%     # gewichtet %
  ungroup()

3.2.7 Übersicht aller elec_ dataframes

3.2.7.1 Function für df() Übersicht

df_overview <- function(df_name) {
  df <- get(df_name)
  cat("====", df_name, "====\n")
  cat("Anzahl Zeilen:", nrow(df), "\n")
  cat("Anzahl Spalten:", ncol(df), "\n")
  cat("Spaltennamen:\n")

  print(names(df))
  
  # Dynamische Sortierung: Nur vorhandene Spalten werden verwendet
  sort_cols <- c()
  sort_orders <- c()
  
  # 1) Nach year (aufsteigend)
  if ("year" %in% names(df)) {
    df$year <- as.numeric(df$year)
    sort_cols <- c(sort_cols, "year")
    sort_orders <- c(sort_orders, TRUE) # TRUE = aufsteigend
  }
  # 2) Nach Gemeinde (alphabetisch)
  if ("Gemeinde" %in% names(df)) {
    sort_cols <- c(sort_cols, "Gemeinde")
    sort_orders <- c(sort_orders, TRUE)
  }
  # 3) Kt (alphabetisch)
  if ("Kt" %in% names(df)) {
    sort_cols <- c(sort_cols, "Kt")
    sort_orders <- c(sort_orders, TRUE)
  }
  # 4) n_seats_sum (absteigend)
  if ("n_seats_sum" %in% names(df)) {
    df$n_seats_sum <- as.numeric(df$n_seats_sum)
    sort_cols <- c(sort_cols, "n_seats_sum")
    sort_orders <- c(sort_orders, FALSE) # FALSE = absteigend
  }
  
  # Sortiere Dataframe, falls mindestens eine Sortierspalte vorhanden ist
  if (length(sort_cols) > 0) {
    # Erzeuge eine Liste von Spalten für do.call(order, ...)
    order_args <- lapply(seq_along(sort_cols), function(i) {
      col <- df[[sort_cols[i]]]
      if (!sort_orders[i]) -col else col
    })
    df <- df[do.call(order, order_args), ]
  }
  
  # Prüfung auf gültige Zahlen in n_seats_sum
  if ("n_seats_sum" %in% names(df)) {
    valid_rows <- !is.na(df$n_seats_sum) & is.finite(as.numeric(df$n_seats_sum))
    if (any(!valid_rows)) {
      last_valid_row <- which(!valid_rows)[1] - 1
    } else {
      last_valid_row <- nrow(df)
    }
    rows_to_show <- 1:max(1, last_valid_row)
    cat("Zeilen mit Zahlen in 'n_seats_sum' (sortiert):\n")
    print(df[rows_to_show, , drop = FALSE])
  } else {
    cat("Erste 3 Zeilen:\n")
    print(head(df, 3))
  }
  cat("\n\n")}

3.2.7.2 df für Übersicht definieren und Function ausführen

# Liste der Dataframes
df_names <- c("elec_gemeinde_lvl_gemeinde",
              "elec_gemeinde_lvl_kt",
              "elec_gemeinde_lvl_state",
              "elec_kanton_lvl_kt",
              "elec_kanton_lvl_state",
              "elec_nr_sr_lvl_state")


# Übersicht für alle Dataframes erstellen
for (name in df_names) {
  df_overview(name)}

==== elec_gemeinde_lvl_gemeinde ====
Anzahl Zeilen: 4637 
Anzahl Spalten: 5 
Spaltennamen:
[1] "year"        "Gemeinde"    "Partei"      "n_seats_sum" "n_seats_pct"
Zeilen mit Zahlen in 'n_seats_sum' (sortiert):
# A tibble: 4,637 × 5
    year Gemeinde Partei n_seats_sum n_seats_pct
   <dbl> <chr>    <chr>        <dbl>       <dbl>
 1  2019 Aarau    FDP              2        28.6
 2  2019 Aarau    SP               2        28.6
 3  2019 Aarau    CVP              1        14.3
 4  2019 Aarau    GRÜNE            1        14.3
 5  2019 Aarau    ÜBRIGE           1        14.3
 6  2019 Adliswil FDP              2        28.6
 7  2019 Adliswil ÜBRIGE           2        28.6
 8  2019 Adliswil CVP              1        14.3
 9  2019 Adliswil SP               1        14.3
10  2019 Adliswil SVP              1        14.3
# ℹ 4,627 more rows


==== elec_gemeinde_lvl_kt ====
Anzahl Zeilen: 1083 
Anzahl Spalten: 7 
Spaltennamen:
[1] "year"                 "Kt"                   "Partei"              
[4] "n_seats_sum"          "n_seats_sum_weighted" "n_seats_pct"         
[7] "n_seats_pct_weighted"
Zeilen mit Zahlen in 'n_seats_sum' (sortiert):
# A tibble: 1,083 × 7
    year Kt    Partei n_seats_sum n_seats_sum_weighted n_seats_pct
   <dbl> <chr> <chr>        <dbl>                <dbl>       <dbl>
 1  2019 AG    FDP             17               247929       25   
 2  2019 AG    ÜBRIGE          15               219033       22.1 
 3  2019 AG    SP              13               200875       19.1 
 4  2019 AG    CVP             11               179675       16.2 
 5  2019 AG    SVP              6                74557        8.82
 6  2019 AG    GRÜNE            4                60825        5.88
 7  2019 AG    GLP              2                25188        2.94
 8  2019 AR    ÜBRIGE           2                31490       28.6 
 9  2019 AR    CVP              1                15745       14.3 
10  2019 AR    EVP              1                15745       14.3 
# ℹ 1,073 more rows
# ℹ 1 more variable: n_seats_pct_weighted <dbl>


==== elec_gemeinde_lvl_state ====
Anzahl Zeilen: 103 
Anzahl Spalten: 6 
Spaltennamen:
[1] "year"                 "Partei"               "n_seats_sum"         
[4] "n_seats_sum_weighted" "n_seats_pct"          "n_seats_pct_weighted"
Zeilen mit Zahlen in 'n_seats_sum' (sortiert):
# A tibble: 103 × 6
    year Partei n_seats_sum n_seats_sum_weighted n_seats_pct
   <dbl> <chr>        <dbl>                <dbl>       <dbl>
 1  2019 FDP            292              6410290      27.7  
 2  2019 SP             220              7087159      20.8  
 3  2019 CVP            162              3380882      15.3  
 4  2019 SVP            131              2152118      12.4  
 5  2019 ÜBRIGE         105              2003701       9.94 
 6  2019 GRÜNE           63              3023756       5.97 
 7  2019 GLP             29              1064924       2.75 
 8  2019 EVP             20               324771       1.89 
 9  2019 CSP              8               122063       0.758
10  2019 BDP              7               127311       0.663
# ℹ 93 more rows
# ℹ 1 more variable: n_seats_pct_weighted <dbl>


==== elec_kanton_lvl_kt ====
Anzahl Zeilen: 3848 
Anzahl Spalten: 5 
Spaltennamen:
[1] "year"        "Kt"          "Partei"      "n_seats_sum" "n_seats_pct"
Zeilen mit Zahlen in 'n_seats_sum' (sortiert):
# A tibble: 3,848 × 5
    year Kt    Partei n_seats_sum n_seats_pct
   <dbl> <chr> <chr>        <dbl>       <dbl>
 1  2019 AG    SVP              2          40
 2  2019 AG    CVP              1          20
 3  2019 AG    FDP              1          20
 4  2019 AG    SP               1          20
 5  2019 AG    BDP              0           0
 6  2019 AG    CSP              0           0
 7  2019 AG    DEM              0           0
 8  2019 AG    DSP              0           0
 9  2019 AG    EDU              0           0
10  2019 AG    EVP              0           0
# ℹ 3,838 more rows


==== elec_kanton_lvl_state ====
Anzahl Zeilen: 148 
Anzahl Spalten: 7 
Spaltennamen:
[1] "year"                       "Partei"                    
[3] "n_seats_sum"                "n_seats_sum_weighted"      
[5] "stimmberechtigte_avg_state" "n_seats_pct"               
[7] "n_seats_pct_weighted"      
Zeilen mit Zahlen in 'n_seats_sum' (sortiert):
# A tibble: 148 × 7
    year Partei n_seats_sum n_seats_sum_weighted stimmberechtigte_avg_state
   <dbl> <chr>        <dbl>                <dbl>                      <dbl>
 1  2019 FDP             39            211955133                    5434747
 2  2019 CVP             38            206520386                    5434747
 3  2019 SP              30            163042410                    5434747
 4  2019 SVP             24            130433928                    5434747
 5  2019 ÜBRIGE           8             43477976                    5434747
 6  2019 GRÜNE            7             38043229                    5434747
 7  2019 BDP              3             16304241                    5434747
 8  2019 LEGA             2             10869494                    5434747
 9  2019 CSP              1              5434747                    5434747
10  2019 LP               1              5434747                    5434747
# ℹ 138 more rows
# ℹ 2 more variables: n_seats_pct <dbl>, n_seats_pct_weighted <dbl>


==== elec_nr_sr_lvl_state ====
Anzahl Zeilen: 85 
Anzahl Spalten: 4 
Spaltennamen:
[1] "year"        "Partei"      "n_seats_sum" "n_seats_pct"
Zeilen mit Zahlen in 'n_seats_sum' (sortiert):
# A tibble: 85 × 4
    year Partei n_seats_sum n_seats_pct
   <dbl> <chr>        <dbl>       <dbl>
 1  2019 SVP             59      24.0  
 2  2019 SP              48      19.5  
 3  2019 FDP             41      16.7  
 4  2019 CVP             38      15.4  
 5  2019 GRÜNE           33      13.4  
 6  2019 GLP             16       6.50 
 7  2019 BDP              3       1.22 
 8  2019 EVP              3       1.22 
 9  2019 EDU              1       0.407
10  2019 LEGA             1       0.407
# ℹ 75 more rows

3.3 Abstimmungen - Daten laden & Umformen

3.3.1 Swissvotes-Datensatz mit Abstimmungsdetails laden

# Ergbenisse der Schweizweite Abstimmungen laden
voting_raw <- read_delim("data/abstimmungen_swissvotes_DATASET CSV 09-02-2025.csv",
                     delim = ";",
                     escape_double = FALSE,
                     trim_ws = TRUE,
                     show_col_types = FALSE)

# Datum formatieren
voting_raw <- voting_raw %>% 
  mutate(datum = dmy(datum))

##DATUMSFILTER##
# Einträge vor 2019 exkludieren
voting_raw_5y <- voting_raw %>%
  filter(datum >= as.Date("2019-01-01"))

# Parteien aus Parolen-Spalten (p- & pdev-..-..) identifizieren
lookup_input_party_label_vote <- bind_rows(
  # Block 1: Staatsebene - Mutterparteien, Verbände & weitere Organisationen
  tibble(party_orig_value = grep("^p-",
                               names(voting_raw_5y),
                               value = TRUE)) %>%
    mutate(level = "state") %>%
    separate(
      party_orig_value,
      into = c("prefix", "short_name", "add_info"),
      sep = "[-_]",
      remove = FALSE,
      extra = "merge",
      fill = "right"),
  # Block 2: Kantonsebene - Jungparteien, Frauensektionen, etc.
  tibble(party_orig_value = grep("^pdev-",
                               names(voting_raw_5y),
                               value = TRUE)) %>%
    mutate(level = "canton_fraction") %>%
    separate(
      party_orig_value,
      into = c("prefix", "short_name", "add_info"),
      sep = "[-_]",
      remove = FALSE,
      extra = "merge",
      fill = "right")) %>%
  # Großschreibung der short_name-Spalte
  mutate(short_name = toupper(short_name),
         long_name = NA_character_,
         source = "Abstimmungen") %>% 
  select(party_orig_value,
         short_name,
         long_name,
         prefix,
         add_info,
         level,
         source)

3.3.2 Parteinamen Inputs konsolidieren & auf Vollständigkeit prüfen

# Parteilabel-Varaianten aus den Input Files (Wahlen & Abstimmungen) konsolidieren
lookup_input_party_label_combined <- bind_rows(
  lookup_input_canton_parties_label,
  lookup_input_gemeinde_parties_label,
  lookup_input_nr_sr_parties_label,
  lookup_input_party_label_vote) %>%
  distinct()


# Abgleich der Parteinamen mit Lookup-Master
# Fehlende Werte mittels Anti-Join in separatem Dataframe speichern
lookup_input_party_label_missing_in_master <- lookup_input_party_label_combined %>%
  anti_join(
    lookup_parties_consolidated %>% select(party_orig_value),
    by = "party_orig_value")

# Ergebnis anzeigen
if (nrow(lookup_input_party_label_missing_in_master) > 0) {
  print(lookup_input_party_label_missing_in_master)
} else {
  message("Partei Lookup Master ist vollständig")
}

3.3.3 Clean-up “lookup”: Obsolete Objekte (nach konsolidierung) löschen

# Clean-up: Nicht mehr benötigte "lookup" Tabellen löschen
 rm(list = ls(pattern = "^lookup_input")[       # mit lookup_input starten aber
   !grepl("(_combined|_master)$",   # nicht mit _combined / all_final enden
          ls(pattern = "^lookup_input"))])

3.4 Abstimmungsergebnisse transformieren & ergänzen

3.4.1 Transformation: Vom Wide ins Long Format

3.4.1.1 Präfix-Spalten: “p-” / “pdev-” & “-pos” inkl. Parolencluster transformieren

# Spaltennamen extrahieren, die ins Long Format sollen
sel_cols <- names(voting_raw_5y)[
  grepl("^p-|^pdev-|(-pos)",
        names(voting_raw_5y))
]

# Spalteninhalte als Charakter definieren
voting_raw_5y[sel_cols] <- lapply(voting_raw_5y[sel_cols],
                                             as.character)

# Wide in Long Format
tmp_voting_long <- voting_raw_5y %>%  pivot_longer(cols = all_of(sel_cols),
                                               names_to = "variable",
                                               values_to = "value")

# Table: Lookup für p- und pdev-
lookup_parole <- read.table(text = '1\tparole_Ja
                                    2\tparole_Nein
                                    3\tparole_keine
                                    4\tparole_Enthalten
                                    5\tparole_keine
                                    8\tparole_Gegenentwurf (Stichfrage))
                                    9\tparole_Volksinitiative (Stichfrage)
                                    66\tparole_keine
                                    .\tparole_keine
                                    9999\tparole_keine
                                    \tparole_keine',
                            sep = "\t",
                            col.names = c("wert",
                                          "label"),
                            stringsAsFactors = FALSE,
                            fill = TRUE,
                            quote = "")

# Table: Lookup für -pos
lookup_pos <- read.table(text = '.\tpos_Missing
                                  1\tpos_Befürwortend
                                  2\tpos_Ablehnend
                                  3\tpos_Keine
                                  8\tpos_Vorzug Gegenentwurf (bei Stichfragen)
                                  9\tpos_Vorzug Volksinitiative (bei Stichfragen)',
                         sep = "\t",
                         col.names = c("wert",
                                       "label"),
                         stringsAsFactors = FALSE,
                         fill = TRUE,
                         quote = "")
lookup_pos$wert <- as.character(trimws(lookup_pos$wert))


# Lookup anwenden (Join)
# value als Character
lookup_parole$wert <- as.character(trimws(lookup_parole$wert))
lookup_pos$wert <- as.character(trimws(lookup_pos$wert))
tmp_voting_long$value <- as.character(trimws(tmp_voting_long$value))

# Join je nach variable-Typ
tmp_voting_long <- tmp_voting_long %>%
  mutate(value = trimws(value))  %>%
  mutate(lookup_type = case_when(grepl("^p-|^pdev-",
                                       variable) ~ "parole",
                                 grepl("-pos",
                                       variable) ~ "pos",
                                 TRUE ~ NA_character_)) %>%
  left_join(lookup_parole %>%
              rename(label_parole = label),
            by = c("value" = "wert"),
            na_matches = "never") %>%
  left_join(lookup_pos %>%
              rename(label_pos = label),
            by = c("value" = "wert"),
            na_matches = "never") %>%
  mutate(label = case_when(lookup_type == "parole" ~ label_parole,
                           lookup_type == "pos" ~ label_pos,
                           TRUE ~ NA_character_)) %>%
  select(-label_parole,
         -label_pos,
         -lookup_type)


# NA korrigeren (= keine Meinung/Empfehlung)
tmp_voting_long <- tmp_voting_long %>%
  mutate(label = case_when(
    is.na(label) & grepl("^p-|^pdev-", variable) ~ "parole_keine",
    is.na(label) & grepl("-pos", variable)       ~ "pos_keine",
    TRUE                                         ~ label))

# One-Hot-Encoding (Dummy-Codierung)
tmp_voting_long$dummy <- 1L

# Pivotieren: Jede label-Ausprägung wird eigene Spalte, 1 falls zutreffend, sonst 0
tmp_voting_wide <- tmp_voting_long %>%
  pivot_wider(
    id_cols = setdiff(names(tmp_voting_long), c("value", "label", "dummy")),
    names_from = label,
    values_from = dummy,
    values_fill = 0)

voting_5y_long <- tmp_voting_wide

3.4.1.2 Parteinamen ergänzen & Zeilen mit “-pos”-Endung entfernen

tmp_voting_5y_long <- voting_5y_long %>%
  # Zeilen mit "-pos" in Spalte "variable" herausfiltern 
  filter(!str_detect(variable, "-pos$")) %>%
  left_join(lookup_parties_consolidated %>% select(party_orig_value,
                                                   Partei),
            by = c("variable" = "party_orig_value")) %>% 
   relocate(Partei, .after = variable)

voting_5y_long <- tmp_voting_5y_long
rm(tmp_voting_5y_long)

3.4.1.3 Parteistärken ergänzen

# "year" in Quellen as.numeric() definieren
elec_nr_sr_lvl_state <- elec_nr_sr_lvl_state %>%
  mutate(year = as.numeric(year))
elec_kanton_lvl_state <- elec_kanton_lvl_state %>%
  mutate(year = as.numeric(year))
elec_gemeinde_lvl_state <- elec_gemeinde_lvl_state %>%
  mutate(year = as.numeric(year))

# Parteistärken (Staatsebene) dazu laden
voting_5y_long_strength <- voting_5y_long %>%
  filter(!grepl("^pdev-", variable)) %>%      # pdev- ausschliessen
  mutate(year = as.numeric(year(datum))) %>%
  select(anr, year, Partei, annahme, parole_Ja, parole_Nein, parole_keine) %>% 
  
  # National- und Ständerat
  left_join(elec_nr_sr_lvl_state %>% select(year,
                                            Partei,
                                            n_seats_sum,
                                            n_seats_pct) %>%
              rename(n_seats_state = n_seats_sum,
                     n_seats_pct_state = n_seats_pct),
            by = c("year",
                   "Partei")) %>%
  # Kanton
  left_join(elec_kanton_lvl_state %>% select(year,
                                            Partei,
                                            n_seats_sum,
                                            n_seats_pct,
                                            n_seats_sum_weighted,
                                            n_seats_pct_weighted) %>%
              rename(n_seats_kanton = n_seats_sum,
                     n_seats_pct_kanton = n_seats_pct,
                     n_seats_sum_weighted_kt = n_seats_sum_weighted,
                     n_seats_pct_weighted_kt = n_seats_pct_weighted),
            by = c("year", "Partei")) %>%
  # Gemeinde
  left_join(elec_gemeinde_lvl_state %>% select(year,
                                               Partei,
                                               n_seats_sum,
                                               n_seats_pct,
                                               n_seats_sum_weighted,
                                               n_seats_pct_weighted) %>%
              rename(n_seats_gemeinde = n_seats_sum,
                     n_seats_pct_gemeinde = n_seats_pct,
                     n_seats_sum_weighted_gemeinde = n_seats_sum_weighted,
                     n_seats_pct_weighted_gemeinde = n_seats_pct_weighted),
            by = c("year", "Partei")) %>%
  filter(!is.na(Partei)) %>%
  # Prozentwerte pro anr/year normieren (Für noch enthaltene Parteien)
  group_by(anr, year) %>%
  mutate(n_seats_pct_state_norm =
           n_seats_pct_state / sum(n_seats_pct_state,
                                   na.rm = TRUE),
         n_seats_pct_weighted_kt_norm =
           n_seats_pct_weighted_kt / sum(n_seats_pct_weighted_kt,
                                         na.rm = TRUE),
         n_seats_pct_weighted_gemeinde_norm =
           n_seats_pct_weighted_gemeinde / sum(n_seats_pct_weighted_gemeinde,
                                               na.rm = TRUE)) %>%
  ungroup()


# Parteistärke anwenden und aufsummieren
# # tmp
# voting_5y_long_strength_with_seats <- voting_5y_long_strength %>% 
#   filter(n_seats_state > 0 |
#          n_seats_kanton > 0 |
#          n_seats_gemeinde > 0)

# Neue Spalten mit den gewichteten Parolen berechnen (mit den normierten Prozentwerten)
voting_5y_long_strength_wtd <- voting_5y_long_strength %>%
  mutate(
    parole_Nein_wtd_state     = parole_Nein   * n_seats_pct_state_norm,
    parole_Ja_wtd_state       = parole_Ja     * n_seats_pct_state_norm,
    parole_Keine_wtd_state    = parole_keine  * n_seats_pct_state_norm,
    
    parole_Nein_wtd_kt        = parole_Nein   * n_seats_pct_weighted_kt_norm,
    parole_Ja_wtd_kt          = parole_Ja     * n_seats_pct_weighted_kt_norm,
    parole_Keine_wtd_kt       = parole_keine  * n_seats_pct_weighted_kt_norm,
    
    parole_Nein_wtd_gem       = parole_Nein   * n_seats_pct_weighted_gemeinde_norm,
    parole_Ja_wtd_gem         = parole_Ja     * n_seats_pct_weighted_gemeinde_norm,
    parole_Keine_wtd_gem      = parole_keine  * n_seats_pct_weighted_gemeinde_norm)

# Gruppieren und aufsummieren nach anr und year
voting_5y_long_strength_wtd_summary <- voting_5y_long_strength_wtd %>%
  group_by(anr, year, annahme) %>%
  summarise(
    state_parole_Nein       = 100 * sum(parole_Nein_wtd_state, na.rm = TRUE),
    state_parole_Ja         = 100 * sum(parole_Ja_wtd_state, na.rm = TRUE),
    state_parole_Keine      = 100 * sum(parole_Keine_wtd_state, na.rm = TRUE),
    
    kt_parole_Nein          = 100 * sum(parole_Nein_wtd_kt, na.rm = TRUE),
    kt_parole_Ja            = 100 * sum(parole_Ja_wtd_kt, na.rm = TRUE),
    kt_parole_Keine         = 100 * sum(parole_Keine_wtd_kt, na.rm = TRUE),
    
    gemeinde_parole_Nein    = 100 * sum(parole_Nein_wtd_gem, na.rm = TRUE),
    gemeinde_parole_Ja      = 100 * sum(parole_Ja_wtd_gem, na.rm = TRUE),
    gemeinde_parole_Keine   = 100 * sum(parole_Keine_wtd_gem, na.rm = TRUE),
    .groups = "drop")

# Kontrolle:  Summen = 100 ?
voting_5y_long_strength_wtd_summary %>%
  mutate(parole_sum = 
           state_parole_Nein + state_parole_Ja + state_parole_Keine) %>%
  select(anr, year, parole_sum) %>% 
  arrange(desc(parole_sum))

# A tibble: 52 × 3
     anr  year parole_sum
   <dbl> <dbl>      <dbl>
 1   626  2019        100
 2   637  2020        100
 3   627  2019        100
 4   628  2019        100
 5   630  2020        100
 6   631  2020        100
 7   633  2020        100
 8   634  2020        100
 9   636  2020        100
10   638  2021        100
# ℹ 42 more rows

# write_xlsx(voting_5y_long_strength_wtd_summary, "tmp_voting_5y_long_strength_wtd_summary.xlsx")

3.4.1.4 Spalten ergänzen (aus Urprungsfile)

str(voting_5y_long)

tibble [25,844 × 380] (S3: tbl_df/tbl/data.frame)
 $ anr                : num [1:25844] 626 626 626 626 626 626 626 626 626 626 ...
 $ datum              : Date[1:25844], format: "2019-02-10" "2019-02-10" ...
 $ titel_kurz_d       : chr [1:25844] "Zersiedelungsinitiative" "Zersiedelungsinitiative" "Zersiedelungsinitiative" "Zersiedelungsinitiative" ...
 $ titel_kurz_f       : chr [1:25844] "Initiative contre le mitage" "Initiative contre le mitage" "Initiative contre le mitage" "Initiative contre le mitage" ...
 $ titel_kurz_e       : chr [1:25844] "Initiative against urban sprawl" "Initiative against urban sprawl" "Initiative against urban sprawl" "Initiative against urban sprawl" ...
 $ titel_off_d        : chr [1:25844] "Volksinitiative «Zersiedelung stoppen – für eine nachhaltige Siedlungsentwicklung (Zersiedelungsinitiative)»" "Volksinitiative «Zersiedelung stoppen – für eine nachhaltige Siedlungsentwicklung (Zersiedelungsinitiative)»" "Volksinitiative «Zersiedelung stoppen – für eine nachhaltige Siedlungsentwicklung (Zersiedelungsinitiative)»" "Volksinitiative «Zersiedelung stoppen – für eine nachhaltige Siedlungsentwicklung (Zersiedelungsinitiative)»" ...
 $ titel_off_f        : chr [1:25844] "Initiative populaire «Stopper le mitage – pour un développement durable du milieu bâti (initiative contre le mitage)»" "Initiative populaire «Stopper le mitage – pour un développement durable du milieu bâti (initiative contre le mitage)»" "Initiative populaire «Stopper le mitage – pour un développement durable du milieu bâti (initiative contre le mitage)»" "Initiative populaire «Stopper le mitage – pour un développement durable du milieu bâti (initiative contre le mitage)»" ...
 $ stichwort          : chr [1:25844] "." "." "." "." ...
 $ swissvoteslink     : chr [1:25844] "https://swissvotes.ch/vote/626.00" "https://swissvotes.ch/vote/626.00" "https://swissvotes.ch/vote/626.00" "https://swissvotes.ch/vote/626.00" ...
 $ anzahl             : num [1:25844] 1 1 1 1 1 1 1 1 1 1 ...
 $ rechtsform         : num [1:25844] 3 3 3 3 3 3 3 3 3 3 ...
 $ init_formul        : num [1:25844] 1 1 1 1 1 1 1 1 1 1 ...
 $ kurzbetitel        : chr [1:25844] "Volk und Stände wollen keine starre Bauzonenobergrenze" "Volk und Stände wollen keine starre Bauzonenobergrenze" "Volk und Stände wollen keine starre Bauzonenobergrenze" "Volk und Stände wollen keine starre Bauzonenobergrenze" ...
 $ anneepolitique     : chr [1:25844] "https://anneepolitique.swiss/prozesse/58251" "https://anneepolitique.swiss/prozesse/58251" "https://anneepolitique.swiss/prozesse/58251" "https://anneepolitique.swiss/prozesse/58251" ...
 $ bkchrono-de        : chr [1:25844] "https://www.bk.admin.ch/ch/d/pore/vi/vis461.html" "https://www.bk.admin.ch/ch/d/pore/vi/vis461.html" "https://www.bk.admin.ch/ch/d/pore/vi/vis461.html" "https://www.bk.admin.ch/ch/d/pore/vi/vis461.html" ...
 $ bkchrono-fr        : chr [1:25844] "https://www.bk.admin.ch/ch/f/pore/vi/vis461.html" "https://www.bk.admin.ch/ch/f/pore/vi/vis461.html" "https://www.bk.admin.ch/ch/f/pore/vi/vis461.html" "https://www.bk.admin.ch/ch/f/pore/vi/vis461.html" ...
 $ d1e1               : num [1:25844] 9 9 9 9 9 9 9 9 9 9 ...
 $ d1e2               : chr [1:25844] "9.1" "9.1" "9.1" "9.1" ...
 $ d1e3               : chr [1:25844] "9.11" "9.11" "9.11" "9.11" ...
 $ d2e1               : chr [1:25844] "." "." "." "." ...
 $ d2e2               : chr [1:25844] "." "." "." "." ...
 $ d2e3               : chr [1:25844] "." "." "." "." ...
 $ d3e1               : chr [1:25844] "." "." "." "." ...
 $ d3e2               : chr [1:25844] "." "." "." "." ...
 $ d3e3               : chr [1:25844] "." "." "." "." ...
 $ dep                : chr [1:25844] "7" "7" "7" "7" ...
 $ legislatur         : num [1:25844] 50 50 50 50 50 50 50 50 50 50 ...
 $ legisjahr          : chr [1:25844] "2015-2019" "2015-2019" "2015-2019" "2015-2019" ...
 $ gesch_nr           : chr [1:25844] "17.063" "17.063" "17.063" "17.063" ...
 $ entwurf_nr         : num [1:25844] 1 1 1 1 1 1 1 1 1 1 ...
 $ curiavista-de      : chr [1:25844] "https://www.parlament.ch/de/ratsbetrieb/suche-curia-vista/geschaeft?AffairId=20170063" "https://www.parlament.ch/de/ratsbetrieb/suche-curia-vista/geschaeft?AffairId=20170063" "https://www.parlament.ch/de/ratsbetrieb/suche-curia-vista/geschaeft?AffairId=20170063" "https://www.parlament.ch/de/ratsbetrieb/suche-curia-vista/geschaeft?AffairId=20170063" ...
 $ curiavista-fr      : chr [1:25844] "https://www.parlament.ch/fr/ratsbetrieb/suche-curia-vista/geschaeft?AffairId=20170063" "https://www.parlament.ch/fr/ratsbetrieb/suche-curia-vista/geschaeft?AffairId=20170063" "https://www.parlament.ch/fr/ratsbetrieb/suche-curia-vista/geschaeft?AffairId=20170063" "https://www.parlament.ch/fr/ratsbetrieb/suche-curia-vista/geschaeft?AffairId=20170063" ...
 $ pa-iv              : num [1:25844] 0 0 0 0 0 0 0 0 0 0 ...
 $ nrja               : chr [1:25844] "37" "37" "37" "37" ...
 $ nrnein             : chr [1:25844] "143" "143" "143" "143" ...
 $ srja               : chr [1:25844] "3" "3" "3" "3" ...
 $ srnein             : chr [1:25844] "34" "34" "34" "34" ...
 $ dat-preexam        : chr [1:25844] "07.04.2015" "07.04.2015" "07.04.2015" "07.04.2015" ...
 $ dat-start          : chr [1:25844] "21.04.2015" "21.04.2015" "21.04.2015" "21.04.2015" ...
 $ dat-limit          : chr [1:25844] "21.10.2016" "21.10.2016" "21.10.2016" "21.10.2016" ...
 $ sammelfrist        : num [1:25844] 549 549 549 549 549 549 549 549 549 549 ...
 $ unter-quorum       : chr [1:25844] "100’000" "100’000" "100’000" "100’000" ...
 $ dat-submit         : chr [1:25844] "21.10.2016" "21.10.2016" "21.10.2016" "21.10.2016" ...
 $ dat-success        : chr [1:25844] "29.11.2016" "29.11.2016" "29.11.2016" "29.11.2016" ...
 $ dat-message        : chr [1:25844] "11.10.2017" "11.10.2017" "11.10.2017" "11.10.2017" ...
 $ dat-parl           : chr [1:25844] "15.06.2018" "15.06.2018" "15.06.2018" "15.06.2018" ...
 $ dat-force          : chr [1:25844] "0" "0" "0" "0" ...
 $ dauer_bv           : chr [1:25844] "247" "247" "247" "247" ...
 $ dauer_abst         : chr [1:25844] "240" "240" "240" "240" ...
 $ i-dauer_tot        : chr [1:25844] "842" "842" "842" "842" ...
 $ i-dauer_samm       : chr [1:25844] "549" "549" "549" "549" ...
 $ i-dauer_br         : chr [1:25844] "355" "355" "355" "355" ...
 $ fr-dauer_samm      : chr [1:25844] "." "." "." "." ...
 $ fr-dauer_tot       : chr [1:25844] "." "." "." "." ...
 $ unter_g            : chr [1:25844] "113216" "113216" "113216" "113216" ...
 $ unter_u            : chr [1:25844] "212" "212" "212" "212" ...
 $ sammeltempo        : chr [1:25844] "206" "206" "206" "206" ...
 $ sparedays          : chr [1:25844] "0" "0" "0" "0" ...
 $ urheber            : chr [1:25844] "Junge Grüne" "Junge Grüne" "Junge Grüne" "Junge Grüne" ...
 $ urheber-fr         : chr [1:25844] "Jeunes Vert-e-s" "Jeunes Vert-e-s" "Jeunes Vert-e-s" "Jeunes Vert-e-s" ...
 $ info_br-de         : chr [1:25844] "https://web.archive.org/web/20190124203413/https://www.admin.ch/gov/de/start/dokumentation/abstimmungen/2019021"| __truncated__ "https://web.archive.org/web/20190124203413/https://www.admin.ch/gov/de/start/dokumentation/abstimmungen/2019021"| __truncated__ "https://web.archive.org/web/20190124203413/https://www.admin.ch/gov/de/start/dokumentation/abstimmungen/2019021"| __truncated__ "https://web.archive.org/web/20190124203413/https://www.admin.ch/gov/de/start/dokumentation/abstimmungen/2019021"| __truncated__ ...
 $ info_br-fr         : chr [1:25844] "https://web.archive.org/web/20190117231207/https://www.admin.ch/gov/fr/accueil/documentation/votations/20190210"| __truncated__ "https://web.archive.org/web/20190117231207/https://www.admin.ch/gov/fr/accueil/documentation/votations/20190210"| __truncated__ "https://web.archive.org/web/20190117231207/https://www.admin.ch/gov/fr/accueil/documentation/votations/20190210"| __truncated__ "https://web.archive.org/web/20190117231207/https://www.admin.ch/gov/fr/accueil/documentation/votations/20190210"| __truncated__ ...
 $ info_br-en         : chr [1:25844] "." "." "." "." ...
 $ info_dep-de        : chr [1:25844] "." "." "." "." ...
 $ info_dep-fr        : chr [1:25844] "." "." "." "." ...
 $ info_dep-en        : chr [1:25844] NA NA NA NA ...
 $ info_amt-de        : chr [1:25844] NA NA NA NA ...
 $ info_amt-fr        : chr [1:25844] NA NA NA NA ...
 $ info_amt-en        : chr [1:25844] NA NA NA NA ...
 $ easyvideo_de       : chr [1:25844] "https://www.youtube.com/watch?v=qoIRWl5oItw" "https://www.youtube.com/watch?v=qoIRWl5oItw" "https://www.youtube.com/watch?v=qoIRWl5oItw" "https://www.youtube.com/watch?v=qoIRWl5oItw" ...
 $ easyvideo_fr       : chr [1:25844] "https://www.youtube.com/watch?v=EONHAANjv9s" "https://www.youtube.com/watch?v=EONHAANjv9s" "https://www.youtube.com/watch?v=EONHAANjv9s" "https://www.youtube.com/watch?v=EONHAANjv9s" ...
 $ web-yes-1-de       : chr [1:25844] NA NA NA NA ...
 $ web-yes-1-fr       : chr [1:25844] NA NA NA NA ...
 $ web-yes-2-de       : chr [1:25844] NA NA NA NA ...
 $ web-yes-2-fr       : chr [1:25844] NA NA NA NA ...
 $ web-yes-3-de       : chr [1:25844] NA NA NA NA ...
 $ web-yes-3-fr       : chr [1:25844] NA NA NA NA ...
 $ web-no-1-de        : chr [1:25844] NA NA NA NA ...
 $ web-no-1-fr        : chr [1:25844] NA NA NA NA ...
 $ web-no-2-de        : chr [1:25844] NA NA NA NA ...
 $ web-no-2-fr        : chr [1:25844] NA NA NA NA ...
 $ web-no-3-de        : chr [1:25844] NA NA NA NA ...
 $ web-no-3-fr        : chr [1:25844] NA NA NA NA ...
 $ nr-wahl            : chr [1:25844] "2015" "2015" "2015" "2015" ...
 $ w-fdp              : chr [1:25844] "16.40" "16.40" "16.40" "16.40" ...
 $ w-sp               : chr [1:25844] "18.80" "18.80" "18.80" "18.80" ...
 $ w-svp              : chr [1:25844] "29.40" "29.40" "29.40" "29.40" ...
 $ w-mitte            : chr [1:25844] "." "." "." "." ...
 $ w-evp              : chr [1:25844] "1.90" "1.90" "1.90" "1.90" ...
 $ w-gps              : chr [1:25844] "7.10" "7.10" "7.10" "7.10" ...
 $ w-glp              : chr [1:25844] "4.60" "4.60" "4.60" "4.60" ...
 $ w-csp              : chr [1:25844] "0.20" "0.20" "0.20" "0.20" ...
 $ w-pda              : chr [1:25844] "0.90" "0.90" "0.90" "0.90" ...
 $ w-sd               : chr [1:25844] "0.10" "0.10" "0.10" "0.10" ...
 $ w-edu              : chr [1:25844] "1.20" "1.20" "1.20" "1.20" ...
 $ w-fps              : chr [1:25844] "0.00" "0.00" "0.00" "0.00" ...
 $ w-lega             : chr [1:25844] "1.00" "1.00" "1.00" "1.00" ...
 $ w-kvp              : chr [1:25844] "." "." "." "." ...
 $ w-mcg              : chr [1:25844] "0.30" "0.30" "0.30" "0.30" ...
  [list output truncated]

colnames(voting_5y_long)

  [1] "anr"                 "datum"               "titel_kurz_d"       
  [4] "titel_kurz_f"        "titel_kurz_e"        "titel_off_d"        
  [7] "titel_off_f"         "stichwort"           "swissvoteslink"     
 [10] "anzahl"              "rechtsform"          "init_formul"        
 [13] "kurzbetitel"         "anneepolitique"      "bkchrono-de"        
 [16] "bkchrono-fr"         "d1e1"                "d1e2"               
 [19] "d1e3"                "d2e1"                "d2e2"               
 [22] "d2e3"                "d3e1"                "d3e2"               
 [25] "d3e3"                "dep"                 "legislatur"         
 [28] "legisjahr"           "gesch_nr"            "entwurf_nr"         
 [31] "curiavista-de"       "curiavista-fr"       "pa-iv"              
 [34] "nrja"                "nrnein"              "srja"               
 [37] "srnein"              "dat-preexam"         "dat-start"          
 [40] "dat-limit"           "sammelfrist"         "unter-quorum"       
 [43] "dat-submit"          "dat-success"         "dat-message"        
 [46] "dat-parl"            "dat-force"           "dauer_bv"           
 [49] "dauer_abst"          "i-dauer_tot"         "i-dauer_samm"       
 [52] "i-dauer_br"          "fr-dauer_samm"       "fr-dauer_tot"       
 [55] "unter_g"             "unter_u"             "sammeltempo"        
 [58] "sparedays"           "urheber"             "urheber-fr"         
 [61] "info_br-de"          "info_br-fr"          "info_br-en"         
 [64] "info_dep-de"         "info_dep-fr"         "info_dep-en"        
 [67] "info_amt-de"         "info_amt-fr"         "info_amt-en"        
 [70] "easyvideo_de"        "easyvideo_fr"        "web-yes-1-de"       
 [73] "web-yes-1-fr"        "web-yes-2-de"        "web-yes-2-fr"       
 [76] "web-yes-3-de"        "web-yes-3-fr"        "web-no-1-de"        
 [79] "web-no-1-fr"         "web-no-2-de"         "web-no-2-fr"        
 [82] "web-no-3-de"         "web-no-3-fr"         "nr-wahl"            
 [85] "w-fdp"               "w-sp"                "w-svp"              
 [88] "w-mitte"             "w-evp"               "w-gps"              
 [91] "w-glp"               "w-csp"               "w-pda"              
 [94] "w-sd"                "w-edu"               "w-fps"              
 [97] "w-lega"              "w-kvp"               "w-mcg"              
[100] "w-cvp"               "w-bdp"               "w-lps"              
[103] "w-ldu"               "w-poch"              "w-rep"              
[106] "w-ubrige"            "ja-lager"            "nein-lager"         
[109] "keinepar-summe"      "leer-summe"          "freigabe-summe"     
[112] "unbekannt-summe"     "neutral-summe"       "poster_ja_mfg"      
[115] "poster_nein_mfg"     "poster_ja_sa"        "poster_nein_sa"     
[118] "poster_ja_bs"        "poster_nein_bs"      "inserate-total"     
[121] "inserate-je-ausgabe" "inserate-ja"         "inserate-nein"      
[124] "inserate-neutral"    "inserate-jaanteil"   "mediares-tot"       
[127] "mediares-d"          "mediares-f"          "mediaton-tot"       
[130] "mediaton-d"          "mediaton-f"          "finanz-link-de"     
[133] "finanz-link-fr"      "finanz-ja-tot"       "finanz-ja-gr-de"    
[136] "finanz-ja-gr-fr"     "finanz-nein-tot"     "finanz-nein-gr-de"  
[139] "finanz-nein-gr-fr"   "volk"                "stand"              
[142] "annahme"             "berecht"             "stimmen"            
[145] "bet"                 "leer"                "ungultig"           
[148] "gultig"              "volkja"              "volknein"           
[151] "volkja-proz"         "kt-ja"               "kt-nein"            
[154] "ktjaproz"            "zh-berecht"          "zh-stimmen"         
[157] "zh-bet"              "zh-gultig"           "zh-ja"              
[160] "zh-nein"             "zh-japroz"           "zh-annahme"         
[163] "be-berecht"          "be-stimmen"          "be-bet"             
[166] "be-gultig"           "be-ja"               "be-nein"            
[169] "be-japroz"           "be-annahme"          "lu-berecht"         
[172] "lu-stimmen"          "lu-bet"              "lu-gultig"          
[175] "lu-ja"               "lu-nein"             "lu-japroz"          
[178] "lu-annahme"          "ur-berecht"          "ur-stimmen"         
[181] "ur-bet"              "ur-gultig"           "ur-ja"              
[184] "ur-nein"             "ur-japroz"           "ur-annahme"         
[187] "sz-berecht"          "sz-stimmen"          "sz-bet"             
[190] "sz-gultig"           "sz-ja"               "sz-nein"            
[193] "sz-japroz"           "sz-annahme"          "ow-berecht"         
[196] "ow-stimmen"          "ow-bet"              "ow-gultig"          
[199] "ow-ja"               "ow-nein"             "ow-japroz"          
[202] "ow-annahme"          "nw-berecht"          "nw-stimmen"         
[205] "nw-bet"              "nw-gultig"           "nw-ja"              
[208] "nw-nein"             "nw-japroz"           "nw-annahme"         
[211] "gl-berecht"          "gl-stimmen"          "gl-bet"             
[214] "gl-gultig"           "gl-ja"               "gl-nein"            
[217] "gl-japroz"           "gl-annahme"          "zg-berecht"         
[220] "zg-stimmen"          "zg-bet"              "zg-gultig"          
[223] "zg-ja"               "zg-nein"             "zg-japroz"          
[226] "zg-annahme"          "fr-berecht"          "fr-stimmen"         
[229] "fr-bet"              "fr-gultig"           "fr-ja"              
[232] "fr-nein"             "fr-japroz"           "fr-annahme"         
[235] "so-berecht"          "so-stimmen"          "so-bet"             
[238] "so-gultig"           "so-ja"               "so-nein"            
[241] "so-japroz"           "so-annahme"          "bs-berecht"         
[244] "bs-stimmen"          "bs-bet"              "bs-gultig"          
[247] "bs-ja"               "bs-nein"             "bs-japroz"          
[250] "bs-annahme"          "bl-berecht"          "bl-stimmen"         
[253] "bl-bet"              "bl-gultig"           "bl-ja"              
[256] "bl-nein"             "bl-japroz"           "bl-annahme"         
[259] "sh-berecht"          "sh-stimmen"          "sh-bet"             
[262] "sh-gultig"           "sh-ja"               "sh-nein"            
[265] "sh-japroz"           "sh-annahme"          "ar-berecht"         
[268] "ar-stimmen"          "ar-bet"              "ar-gultig"          
[271] "ar-ja"               "ar-nein"             "ar-japroz"          
[274] "ar-annahme"          "ai-berecht"          "ai-stimmen"         
[277] "ai-bet"              "ai-gultig"           "ai-ja"              
[280] "ai-nein"             "ai-japroz"           "ai-annahme"         
[283] "sg-berecht"          "sg-stimmen"          "sg-bet"             
[286] "sg-gultig"           "sg-ja"               "sg-nein"            
[289] "sg-japroz"           "sg-annahme"          "gr-berecht"         
[292] "gr-stimmen"          "gr-bet"              "gr-gultig"          
[295] "gr-ja"               "gr-nein"             "gr-japroz"          
[298] "gr-annahme"          "ag-berecht"          "ag-stimmen"         
[301] "ag-bet"              "ag-gultig"           "ag-ja"              
[304] "ag-nein"             "ag-japroz"           "ag-annahme"         
[307] "tg-berecht"          "tg-stimmen"          "tg-bet"             
[310] "tg-gultig"           "tg-ja"               "tg-nein"            
[313] "tg-japroz"           "tg-annahme"          "ti-berecht"         
[316] "ti-stimmen"          "ti-bet"              "ti-gultig"          
[319] "ti-ja"               "ti-nein"             "ti-japroz"          
[322] "ti-annahme"          "vd-berecht"          "vd-stimmen"         
[325] "vd-bet"              "vd-gultig"           "vd-ja"              
[328] "vd-nein"             "vd-japroz"           "vd-annahme"         
[331] "vs-berecht"          "vs-stimmen"          "vs-bet"             
[334] "vs-gultig"           "vs-ja"               "vs-nein"            
[337] "vs-japroz"           "vs-annahme"          "ne-berecht"         
[340] "ne-stimmen"          "ne-bet"              "ne-gultig"          
[343] "ne-ja"               "ne-nein"             "ne-japroz"          
[346] "ne-annahme"          "ge-berecht"          "ge-stimmen"         
[349] "ge-bet"              "ge-gultig"           "ge-ja"              
[352] "ge-nein"             "ge-japroz"           "ge-annahme"         
[355] "ju-berecht"          "ju-stimmen"          "ju-bet"             
[358] "ju-gultig"           "ju-ja"               "ju-nein"            
[361] "ju-japroz"           "ju-annahme"          "bkresults-de"       
[364] "bkresults-fr"        "bfsdash-de"          "bfsdash-fr"         
[367] "bfsdash-en"          "bfsmap-de"           "bfsmap-fr"          
[370] "bfsmap-en"           "nach_cockpit_d"      "nach_cockpit_f"     
[373] "nach_cockpit_e"      "variable"            "Partei"             
[376] "pos_Ablehnend"       "parole_Nein"         "parole_Ja"          
[379] "parole_keine"        "pos_Befürwortend"   

# Vorerst ignorierte Spalten (partiell) wieder hinzufügen
voting_5y_final <- voting_5y_long_strength_wtd_summary %>%
  left_join(voting_5y_long %>%
              select(anr,
                     titel_kurz_d,
                     dep,              # 1 Eidg. Dep. für ausw. Angel. (EDA)
                                       # 2 Eidg. Dep. des Innern (EDI)2
                                       # 3 Eidg. Justiz- und PolizeiDep. (EJPD)3
                                       # 4 Eidg. Dep. für Verteidigung,                                                      Bevölkerungsschutz und Sport (VBS)4
                                       # 5 Eidg. FinanzDep. (EFD)5
                                       # 6 Eidg. Dep. für Wirtschaft, Bildung und
                                       # Forschung (WBF)6
                                       # 7 Eidg. Dep. für Umwelt, Verkehr, Energie                                            und Kommunikation (UVEK)7
                                       # 8 Schweizerische Bundeskanzlei (BK)
                     rechtsform,       #1 Obligatorisches Referendum
                                       #2 Fakultatives Referendum
                                       #3 Volksinitiative
                                       #4 Direkter Gegenentwurf zu Volksinitiative
                                       #5 Stichfrage
                     inserate_total      = `inserate-total`,
                     inserate_je_ausgabe = `inserate-je-ausgabe`,
                     inserate_ja         = `inserate-ja`,
                     #inserate_jaanteil   = `inserate-jaanteil`,
                     inserate_nein       = `inserate-nein`,
                     inserate_neutral    = `inserate-neutral`,
                     mediares_tot        = `mediares-tot`,
                     mediaton_tot        = `mediaton-tot`,

                     nrja,
                     nrnein,
                     srja,
                     srnein,
                  
                     bet,
                     leer,
                     ungultig,
                     gultig,
                     volkja_proz        = `volkja-proz`) %>%
              distinct(),
            by = "anr")


# Zeilenzahl prüfen
nrow(voting_5y_final) == nrow(voting_5y_long_strength_wtd_summary)

[1] TRUE

3.4.1.5 Spaltenklassifizierung und Levels

str(voting_5y_final)

tibble [52 × 31] (S3: tbl_df/tbl/data.frame)
 $ anr                  : num [1:52] 626 627 628 629 630 631 632 633 634 635 ...
 $ year                 : num [1:52] 2019 2019 2019 2020 2020 ...
 $ annahme              : chr [1:52] "0" "1" "1" "0" ...
 $ state_parole_Nein    : num [1:52] 64.8 20.1 24.6 66 24.6 ...
 $ state_parole_Ja      : num [1:52] 34.8 54.9 74.6 33.6 73.8 ...
 $ state_parole_Keine   : num [1:52] 0.41 25 0.82 0.41 1.64 ...
 $ kt_parole_Nein       : num [1:52] 71.72 4.83 16.55 70.63 17.48 ...
 $ kt_parole_Ja         : num [1:52] 25.5 75.9 80.7 25.9 79 ...
 $ kt_parole_Keine      : num [1:52] 2.76 19.31 2.76 3.5 3.5 ...
 $ gemeinde_parole_Nein : num [1:52] 53.89 16.74 8.92 54.56 8.76 ...
 $ gemeinde_parole_Ja   : num [1:52] 43.7 71.1 87.7 42.5 86.9 ...
 $ gemeinde_parole_Keine: num [1:52] 2.4 12.2 3.38 2.98 4.29 ...
 $ titel_kurz_d         : chr [1:52] "Zersiedelungsinitiative" "Steuerreform und AHV-Finanzierung (STAF)" "Umsetzung der EU-Waffenrichtlinie" "Initiative «Mehr bezahlbare Wohnungen»" ...
 $ dep                  : chr [1:52] "7" "5" "3" "6" ...
 $ rechtsform           : num [1:52] 3 2 2 3 2 3 2 2 2 2 ...
 $ inserate_total       : chr [1:52] "290" "774" "364" "275" ...
 $ inserate_je_ausgabe  : chr [1:52] "0.15" "0.40" "0.19" "0.14" ...
 $ inserate_ja          : chr [1:52] "15" "760" "252" "41" ...
 $ inserate_nein        : chr [1:52] "258" "5" "102" "234" ...
 $ inserate_neutral     : chr [1:52] "17" "9" "10" "0" ...
 $ mediares_tot         : chr [1:52] "312" "455" "344" "253" ...
 $ mediaton_tot         : chr [1:52] "-14" "16" "26" "0" ...
 $ nrja                 : chr [1:52] "37" "112" "120" "56" ...
 $ nrnein               : chr [1:52] "143" "67" "69" "140" ...
 $ srja                 : chr [1:52] "3" "39" "34" "13" ...
 $ srnein               : chr [1:52] "34" "4" "6" "30" ...
 $ bet                  : chr [1:52] "37.92" "43.74" "43.88" "41.68" ...
 $ leer                 : chr [1:52] "23068" "49337" "23110" "28176" ...
 $ ungultig             : chr [1:52] "7116" "8477" "7687" "6661" ...
 $ gultig               : num [1:52] 2028754 2321604 2356154 2244071 2241395 ...
 $ volkja_proz          : num [1:52] 36.3 66.4 63.7 43 63.1 ...

voting_5y_final <- voting_5y_final %>%
  mutate(annahme                = as.numeric(annahme),
         dep                    = factor(rechtsform,
                                         levels = c("1", "2", "3", "4",
                                                    "5", "6", "7", "8"),
                                         labels = c("EDA", "EDI", "EJPD", "VBS",
                                                    "EFD", "WBF", "UVEK", "BK" )),
         rechtsform             = factor(rechtsform,
                                        levels = c("1","2","3","4","5"),
                                        labels = c("Obligatorisches Referendum",
                                                   "Fakultatives Referendum",
                                                   "Volksinitiative",
                                                   "Direkter Gegenentwurf",
                                                   "Stichfrage")),
         inserate_total         = as.numeric(inserate_total),
         inserate_je_ausgabe    = as.numeric(inserate_je_ausgabe),
         inserate_ja            = as.numeric(inserate_ja),
         inserate_nein          = as.numeric(inserate_nein),
         inserate_neutral       = as.numeric(inserate_neutral),
         #inserate_ja_pct        = as.numeric(inserate_ja),
         #inserate_nein_pct      = as.numeric(inserate_nein),
         #inserate_neutral_pct   = as.numeric(inserate_neutral),
         nrja                   = as.numeric(nrja),
         #nrja_pct               = as.numeric(nrja_pct),
         nrnein                 = as.numeric(nrnein),
         #nrnein_pct             = as.numeric(nrnein_pct),
         srja                   = as.numeric(srja),
         #srja_pct               = as.numeric(srja_pct),
         srnein                 = as.numeric(srnein),
         #srnein_pct             = as.numeric(srnein_pct),

         mediares_tot           = as.numeric(mediares_tot),
         mediaton_tot           = as.numeric(mediaton_tot),
         bet                    = as.numeric(bet),
         leer                   = as.numeric(leer),
         ungultig               = as.numeric(ungultig),
         gultig                 = as.numeric(gultig))

str(voting_5y_final)

tibble [52 × 31] (S3: tbl_df/tbl/data.frame)
 $ anr                  : num [1:52] 626 627 628 629 630 631 632 633 634 635 ...
 $ year                 : num [1:52] 2019 2019 2019 2020 2020 ...
 $ annahme              : num [1:52] 0 1 1 0 1 0 0 0 1 1 ...
 $ state_parole_Nein    : num [1:52] 64.8 20.1 24.6 66 24.6 ...
 $ state_parole_Ja      : num [1:52] 34.8 54.9 74.6 33.6 73.8 ...
 $ state_parole_Keine   : num [1:52] 0.41 25 0.82 0.41 1.64 ...
 $ kt_parole_Nein       : num [1:52] 71.72 4.83 16.55 70.63 17.48 ...
 $ kt_parole_Ja         : num [1:52] 25.5 75.9 80.7 25.9 79 ...
 $ kt_parole_Keine      : num [1:52] 2.76 19.31 2.76 3.5 3.5 ...
 $ gemeinde_parole_Nein : num [1:52] 53.89 16.74 8.92 54.56 8.76 ...
 $ gemeinde_parole_Ja   : num [1:52] 43.7 71.1 87.7 42.5 86.9 ...
 $ gemeinde_parole_Keine: num [1:52] 2.4 12.2 3.38 2.98 4.29 ...
 $ titel_kurz_d         : chr [1:52] "Zersiedelungsinitiative" "Steuerreform und AHV-Finanzierung (STAF)" "Umsetzung der EU-Waffenrichtlinie" "Initiative «Mehr bezahlbare Wohnungen»" ...
 $ dep                  : Factor w/ 8 levels "EDA","EDI","EJPD",..: 3 2 2 3 2 3 2 2 2 2 ...
 $ rechtsform           : Factor w/ 5 levels "Obligatorisches Referendum",..: 3 2 2 3 2 3 2 2 2 2 ...
 $ inserate_total       : num [1:52] 290 774 364 275 25 ...
 $ inserate_je_ausgabe  : num [1:52] 0.15 0.4 0.19 0.14 0.01 0.34 0.56 0.02 0.12 0.11 ...
 $ inserate_ja          : num [1:52] 15 760 252 41 17 228 288 6 35 177 ...
 $ inserate_nein        : num [1:52] 258 5 102 234 4 422 780 26 196 19 ...
 $ inserate_neutral     : num [1:52] 17 9 10 0 4 8 5 2 1 15 ...
 $ mediares_tot         : num [1:52] 312 455 344 253 249 636 266 172 264 306 ...
 $ mediaton_tot         : num [1:52] -14 16 26 0 37 -35 2 -4 27 13 ...
 $ nrja                 : num [1:52] 37 112 120 56 121 53 117 132 129 123 ...
 $ nrnein               : num [1:52] 143 67 69 140 67 142 71 62 66 68 ...
 $ srja                 : num [1:52] 3 39 34 13 30 5 28 25 31 33 ...
 $ srnein               : num [1:52] 34 4 6 30 12 37 16 17 11 10 ...
 $ bet                  : num [1:52] 37.9 43.7 43.9 41.7 41.7 ...
 $ leer                 : num [1:52] 23068 49337 23110 28176 31597 ...
 $ ungultig             : num [1:52] 7116 8477 7687 6661 6769 ...
 $ gultig               : num [1:52] 2028754 2321604 2356154 2244071 2241395 ...
 $ volkja_proz          : num [1:52] 36.3 66.4 63.7 43 63.1 ...

3.4.1.6 Spalten hinzufügen (berechnet)

# (Alle) Inserate-Anteile in Prozent
voting_5y_final <- voting_5y_final %>%
  mutate(inserate_ja_pct = 100 * inserate_ja / inserate_total,
         inserate_nein_pct = 100 * inserate_nein / inserate_total,
         inserate_neutral_pct = 100 * inserate_neutral / inserate_total,
         nrja_pct     = 100 * nrja / (nrja + nrnein),
         nrnein_pct   = 100 * nrnein / (nrja + nrnein),
         srja_pct     = 100 * srja / (srja + srnein),
         srnein_pct   = 100 * srnein / (srja + srnein))

3.4.1.6.1 Function: “Klassenmutation” Codeblock schreiben

# Funktion: Erzeugt den Mutate-Block
generate_codeblock_4_type_conversion <- function(df, df_name = "df") {
  # Spaltennamen und deren aktuelle Klassen holen
  col_names <- names(df)
  col_classes <- sapply(df, class)
  
  # Länge des längsten Spaltennamens
  max_len <- max(nchar(col_names))
  
  # Erzeuge ästhetische Codezeilen
  code_lines <- purrr::map2_chr(
    col_names, col_classes,
    function(col, col_class) {
      padding <- strrep(" ",
                        max_len - nchar(col))
      paste0("    ", col, padding, " = as.", col_class, "(", col, ")")
    }
  )
  
  # Ganze mutate()-Struktur zusammensetzen
  cat(paste0(
    df_name, " <- ", df_name, " %>%\n",
    "  mutate(\n",
    paste(code_lines, collapse = ",\n"),
    "\n  )\n"
  ))}

# Function ausführen
# df-Namen angeben für 1) Spaltenherkunft und 2) neues df im Codeblock
generate_codeblock_4_type_conversion(voting_5y_final,
                                     "voting_5y_final")

voting_5y_final <- voting_5y_final %>%
  mutate(
    anr                   = as.numeric(anr),
    year                  = as.numeric(year),
    annahme               = as.numeric(annahme),
    state_parole_Nein     = as.numeric(state_parole_Nein),
    state_parole_Ja       = as.numeric(state_parole_Ja),
    state_parole_Keine    = as.numeric(state_parole_Keine),
    kt_parole_Nein        = as.numeric(kt_parole_Nein),
    kt_parole_Ja          = as.numeric(kt_parole_Ja),
    kt_parole_Keine       = as.numeric(kt_parole_Keine),
    gemeinde_parole_Nein  = as.numeric(gemeinde_parole_Nein),
    gemeinde_parole_Ja    = as.numeric(gemeinde_parole_Ja),
    gemeinde_parole_Keine = as.numeric(gemeinde_parole_Keine),
    titel_kurz_d          = as.character(titel_kurz_d),
    dep                   = as.factor(dep),
    rechtsform            = as.factor(rechtsform),
    inserate_total        = as.numeric(inserate_total),
    inserate_je_ausgabe   = as.numeric(inserate_je_ausgabe),
    inserate_ja           = as.numeric(inserate_ja),
    inserate_nein         = as.numeric(inserate_nein),
    inserate_neutral      = as.numeric(inserate_neutral),
    mediares_tot          = as.numeric(mediares_tot),
    mediaton_tot          = as.numeric(mediaton_tot),
    nrja                  = as.numeric(nrja),
    nrnein                = as.numeric(nrnein),
    srja                  = as.numeric(srja),
    srnein                = as.numeric(srnein),
    bet                   = as.numeric(bet),
    leer                  = as.numeric(leer),
    ungultig              = as.numeric(ungultig),
    gultig                = as.numeric(gultig),
    volkja_proz           = as.numeric(volkja_proz),
    inserate_ja_pct       = as.numeric(inserate_ja_pct),
    inserate_nein_pct     = as.numeric(inserate_nein_pct),
    inserate_neutral_pct  = as.numeric(inserate_neutral_pct),
    nrja_pct              = as.numeric(nrja_pct),
    nrnein_pct            = as.numeric(nrnein_pct),
    srja_pct              = as.numeric(srja_pct),
    srnein_pct            = as.numeric(srnein_pct)
  )

3.5 Analysen

3.5.1 Abstimmungsergebnisse mit widersprüchlichen Parolen

3.5.1.1 Data

#relevante Spalten in numerisch umwandeln
voting_5y_final <- voting_5y_final %>%
  mutate(annahme = as.numeric(annahme),
         state_parole_Ja = as.numeric(state_parole_Ja),
         kt_parole_Ja = as.numeric(kt_parole_Ja),
         gemeinde_parole_Ja = as.numeric(gemeinde_parole_Ja))


##################################
##################################
#### ANGENOMMEN
# Angenommene Abstimmungen
angenommen <- voting_5y_final %>%
  filter(annahme == 1)

# Ja-Parole > 50% auf mind. einer Ebene
angenommen <- angenommen %>%
  mutate(ja_parole_50 = (state_parole_Ja >= 50) |
                        (kt_parole_Ja >= 50) |
                        (gemeinde_parole_Ja >= 50))


# Abstimmungen ANGENOMMEN obwohl Parolen ABLEHNEND waren
angenommen_ohne_ja_parole_50 <- angenommen %>%
  filter(ja_parole_50 == FALSE) %>%
  select(anr,
         titel_kurz_d,
         annahme,
         volkja_proz,
         state_parole_Ja,
         kt_parole_Ja,
         gemeinde_parole_Ja)

print(angenommen_ohne_ja_parole_50)

# A tibble: 4 × 7
    anr titel_kurz_d            annahme volkja_proz state_parole_Ja kt_parole_Ja
  <dbl> <chr>                     <dbl>       <dbl>           <dbl>        <dbl>
1   638 Initiative für ein Ver…       1        51.2            25           20.1
2   640 Freihandelsabkommen mi…       1        51.6            48.0         48.6
3   645 Gesetz über polizeilic…       1        56.6            42.2         47.9
4   665 Initiative für eine 13…       1        58.2            39           25.3
# ℹ 1 more variable: gemeinde_parole_Ja <dbl>

##################################
##################################
#### ABGELEHNT
# Abgelehnte Abstimmungen
abgelehnt <- voting_5y_final %>%
  filter(annahme != 1)

# Nein-Parole > 50% auf mind. einer Ebene
abgelehnt <- abgelehnt %>%
  mutate(nein_parole_50 = (state_parole_Nein >= 50) |
                          (kt_parole_Nein >= 50) |
                          (gemeinde_parole_Nein >= 50))

# Abstimmungen ABGELEHNT obwohl Parolen BEFÜRWORTEND waren
abgelehnt_ohne_nein_parole_50 <- abgelehnt %>%
  filter(nein_parole_50 == FALSE) %>%
  select(anr,
         titel_kurz_d,
         annahme,
         volkja_proz,
         state_parole_Nein,
         kt_parole_Nein,
         gemeinde_parole_Nein)

print(abgelehnt_ohne_nein_parole_50)

# A tibble: 12 × 7
     anr titel_kurz_d       annahme volkja_proz state_parole_Nein kt_parole_Nein
   <dbl> <chr>                <dbl>       <dbl>             <dbl>          <dbl>
 1   632 Jagdgesetz               0        48.1              41.4           26.6
 2   633 Erhöhung der steu…       0        36.8              40.6           26.6
 3   639 Gesetz über elekt…       0        35.6              40.6           27.1
 4   641 Trinkwasserinitia…       0        39.3              42.2           49.3
 5   642 Pestizidinitiative       0        39.4              41.8           49.3
 6   644 CO2-Gesetz               0        48.4              25.4           20.1
 7   646 «99%-Initiative»         0        35.1              48.4           50  
 8   653 Gesetz über die S…       0        37.4              35.2           25.7
 9   654 Medienpaket              0        45.4              41.8           44.4
10   661 Verrechnungssteue…       0        48.0              34.8           25.7
11   672 Reform der berufl…       0        32.9              38.5           24.0
12   675 Kündigung wegen E…       0        46.2              38             24.0
# ℹ 1 more variable: gemeinde_parole_Nein <dbl>

3.5.2 Paradoxe Fälle

Ob und wie stark die Parolen der Parteien (auf Staats-, Kantons- und Gemeindeebene) mit dem Abstimmungsausgang zusammenhängen – insbesondere in Fällen, wo die Ja-Parole unter 50 % liegt, die Vorlage aber trotzdem angenommen wird (und umgekehrt).

# Fälle identifizieren: "Paradoxe" Abstimmungen
# Annahme == 1, aber state_parole_Ja < 50 (und/oder die anderen Ebenen)
# Annahme == 0, aber state_parole_Ja >= 50 (und/oder die anderen Ebenen)

# Fälle identifizieren
paradoxe_faelle <- voting_5y_final %>%
  filter((annahme == 1 & (state_parole_Ja < 50 |
                            kt_parole_Ja < 50 |
                            gemeinde_parole_Ja < 50)) |
           (annahme == 0 & (state_parole_Ja >= 50 |
                              kt_parole_Ja >= 50 |
                              gemeinde_parole_Ja >= 50))) %>%
  select(anr, titel_kurz_d, annahme, state_parole_Ja, kt_parole_Ja, gemeinde_parole_Ja)

3.5.2.1 Varianz

# Abweichungen berechnen
voting_5y_final <- voting_5y_final %>%
  mutate(diff_state = state_parole_Ja - volkja_proz,
         diff_kanton = kt_parole_Ja - volkja_proz,
         diff_gemeinde = gemeinde_parole_Ja - volkja_proz)

# Mittelwert und Standardabweichung der Abweichungen je Parole berechnen
summary_stats_v1 <- voting_5y_final %>%
  summarise(mean_state = mean(diff_state),
            sd_state = sd(diff_state),
            mean_kanton = mean(diff_kanton),
            sd_kanton = sd(diff_kanton),
            mean_gemeinde = mean(diff_gemeinde),
            sd_gemeinde = sd(diff_gemeinde)) %>%
  pivot_longer(cols = everything(),
               names_to = c("stat",
                            "Parole"),
               names_sep = "_",
               values_to = "value") %>%
  pivot_wider(names_from = stat,
              values_from = value) %>% 
  mutate(Parole = dplyr::recode(Parole,
                         "state" = "State",
                         "kanton" = "Kanton",
                         "gemeinde" = "Gemeinde"))

# Visualisierung als Balkendiagramm mit Fehlerbalken (±1 SD)
ggplot(summary_stats_v1,
       aes(x = Parole,
           y = mean,
           fill = Parole)) +
  geom_col(width = 0.6,
           color = "black") +
  geom_errorbar(aes(ymin = mean - sd,
                    ymax = mean + sd),
                width = 0.2) +
  theme_minimal() +
  labs(title = "Mittlere Abweichung der Parolen vom Volksentscheid\nmit Standardabweichung",
       x = "Parole",
       y = "Mittlere Abweichung (±1 SD, Prozentpunkte)") +
  guides(fill = "none")

print(summary_stats_v1)

# A tibble: 3 × 3
  Parole     mean    sd
  <chr>     <dbl> <dbl>
1 State    -2.20   13.8
2 Kanton   -1.74   18.6
3 Gemeinde  0.722  16.4

3.5.2.2 Varianz gruppiert nach Rechtsform

# Abweichungen berechnen
voting_5y_final <- voting_5y_final %>%
  mutate(diff_state = state_parole_Ja - volkja_proz,
         diff_kanton = kt_parole_Ja - volkja_proz,
         diff_gemeinde = gemeinde_parole_Ja - volkja_proz)

# Zusammenfassen nach "dep" gruppiert
summary_stats_v2 <- voting_5y_final %>%
  group_by(rechtsform) %>%
  summarise(mean_state = mean(diff_state),
            sd_state = sd(diff_state),
            mean_kanton = mean(diff_kanton),
            sd_kanton = sd(diff_kanton),
            mean_gemeinde = mean(diff_gemeinde),
            sd_gemeinde = sd(diff_gemeinde)) %>%
  pivot_longer(cols = -rechtsform,
               names_to = c("stat", "Parole"),
               names_sep = "_",
               values_to = "value") %>%
  pivot_wider(names_from = stat,
              values_from = value) %>%
  mutate(Parole = dplyr::recode(Parole,
                         "state" = "State",
                         "kanton" = "Kanton",
                         "gemeinde" = "Gemeinde"))

# Visualisierung nach "dep"-Gruppe
ggplot(summary_stats_v2, aes(x = Parole, y = mean, fill = Parole)) +
  geom_col(width = 0.6, color = "black") +
  geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = 0.2) +
  facet_wrap(~ rechtsform) +
  theme_minimal() +
  labs(title = "Mittlere Abweichung der Parolen vom Volksentscheid\nmit Standardabweichung nach Rechtsform",
       x = "Parole",
       y = "Mittlere Abweichung (±1 SD, Prozentpunkte)") +
  guides(fill = "none")

print(summary_stats_v2)

# A tibble: 9 × 4
  rechtsform                 Parole     mean    sd
  <fct>                      <chr>     <dbl> <dbl>
1 Obligatorisches Referendum State    -11.9   8.53
2 Obligatorisches Referendum Kanton    -3.33 12.3 
3 Obligatorisches Referendum Gemeinde -21.1  14.9 
4 Fakultatives Referendum    State      2.40 11.3 
5 Fakultatives Referendum    Kanton     9.97 13.8 
6 Fakultatives Referendum    Gemeinde   6.40 13.6 
7 Volksinitiative            State     -7.62 15.3 
8 Volksinitiative            Kanton   -17.8  12.0 
9 Volksinitiative            Gemeinde  -5.04 16.9 

3.5.2.3 Prüfung der Normalverteilung

3.5.2.3.1 Grafisch

# Nur die beiden großen Gruppen auswählen
gruppen <- c("Fakultatives Referendum", "Volksinitiative")
df_sub <- voting_5y_final %>% filter(rechtsform %in% gruppen)

# Histogramm mit Facet für jede Gruppe
ggplot(df_sub, aes(x = diff_state, fill = rechtsform)) +
  geom_histogram(color = "black", alpha = 0.6, bins = 10) +
  facet_wrap(~ rechtsform) +
  theme_minimal() +
  labs(title = "Histogramm der diff_state nach Rechtsform",
       x = "diff_state", y = "Anzahl")

# QQ-Plot für jede Gruppe
ggplot(df_sub, aes(sample = diff_state)) +
  stat_qq() +
  stat_qq_line() +
  facet_wrap(~ rechtsform) +
  theme_minimal() +
  labs(title = "QQ-Plot der diff_state nach Rechtsform")

3.5.2.3.2 Formale Prüfung (Shapiro-Wilk-Test)

# Shapiro-Wilk-Test für jede Gruppe
shapiro.test(df_sub$diff_state[df_sub$rechtsform == "Fakultatives Referendum"])

    Shapiro-Wilk normality test

data:  df_sub$diff_state[df_sub$rechtsform == "Fakultatives Referendum"]
W = 0.98319, p-value = 0.9108

shapiro.test(df_sub$diff_state[df_sub$rechtsform == "Volksinitiative"])

    Shapiro-Wilk normality test

data:  df_sub$diff_state[df_sub$rechtsform == "Volksinitiative"]
W = 0.97931, p-value = 0.9151

shapiro.test(df_sub$diff_kanton[df_sub$rechtsform == "Fakultatives Referendum"])

    Shapiro-Wilk normality test

data:  df_sub$diff_kanton[df_sub$rechtsform == "Fakultatives Referendum"]
W = 0.96781, p-value = 0.5019

shapiro.test(df_sub$diff_kanton[df_sub$rechtsform == "Volksinitiative"])

    Shapiro-Wilk normality test

data:  df_sub$diff_kanton[df_sub$rechtsform == "Volksinitiative"]
W = 0.89525, p-value = 0.02834

shapiro.test(df_sub$diff_gemeinde[df_sub$rechtsform == "Fakultatives Referendum"])

    Shapiro-Wilk normality test

data:  df_sub$diff_gemeinde[df_sub$rechtsform == "Fakultatives Referendum"]
W = 0.95721, p-value = 0.2801

shapiro.test(df_sub$diff_gemeinde[df_sub$rechtsform == "Volksinitiative"])

    Shapiro-Wilk normality test

data:  df_sub$diff_gemeinde[df_sub$rechtsform == "Volksinitiative"]
W = 0.93253, p-value = 0.1547

3.5.2.3.3 Ergebnisse Shapiro-Wilk-Test (tabellarisch)

# Ergebnisse in Liste schreiben
results_shapiro <- tibble(Ebene = rep(c("Staat", "Kanton", "Gemeinde"),
                                    each = 2),
                        Rechtsform = rep(c("Fakultatives Referendum",
                                           "Volksinitiative"),
                                         times = 3),
                        W = c(
    shapiro.test(df_sub$diff_state[df_sub$rechtsform == "Fakultatives Referendum"])$statistic,
    shapiro.test(df_sub$diff_state[df_sub$rechtsform == "Volksinitiative"])$statistic,
    shapiro.test(df_sub$diff_kanton[df_sub$rechtsform == "Fakultatives Referendum"])$statistic,
    shapiro.test(df_sub$diff_kanton[df_sub$rechtsform == "Volksinitiative"])$statistic,
    shapiro.test(df_sub$diff_gemeinde[df_sub$rechtsform == "Fakultatives Referendum"])$statistic,
    shapiro.test(df_sub$diff_gemeinde[df_sub$rechtsform == "Volksinitiative"])$statistic
  ),
  p_value = c(
    shapiro.test(df_sub$diff_state[df_sub$rechtsform == "Fakultatives Referendum"])$p.value,
    shapiro.test(df_sub$diff_state[df_sub$rechtsform == "Volksinitiative"])$p.value,
    shapiro.test(df_sub$diff_kanton[df_sub$rechtsform == "Fakultatives Referendum"])$p.value,
    shapiro.test(df_sub$diff_kanton[df_sub$rechtsform == "Volksinitiative"])$p.value,
    shapiro.test(df_sub$diff_gemeinde[df_sub$rechtsform == "Fakultatives Referendum"])$p.value,
    shapiro.test(df_sub$diff_gemeinde[df_sub$rechtsform == "Volksinitiative"])$p.value
  )
)

print(results_shapiro)

# A tibble: 6 × 4
  Ebene    Rechtsform                  W p_value
  <chr>    <chr>                   <dbl>   <dbl>
1 Staat    Fakultatives Referendum 0.983  0.911 
2 Staat    Volksinitiative         0.979  0.915 
3 Kanton   Fakultatives Referendum 0.968  0.502 
4 Kanton   Volksinitiative         0.895  0.0283
5 Gemeinde Fakultatives Referendum 0.957  0.280 
6 Gemeinde Volksinitiative         0.933  0.155 

3.5.2.4 Prüfung der Varianzhomogenität (Levene-Test)

leveneTest(diff_state ~ rechtsform, data = df_sub)

Levene's Test for Homogeneity of Variance (center = median)
      Df F value Pr(>F)
group  1  1.3502  0.251
      48               

leveneTest(diff_kanton ~ rechtsform, data = df_sub)

Levene's Test for Homogeneity of Variance (center = median)
      Df F value Pr(>F)
group  1   0.641 0.4273
      48               

leveneTest(diff_gemeinde ~ rechtsform, data = df_sub)

Levene's Test for Homogeneity of Variance (center = median)
      Df F value Pr(>F)
group  1  0.7233 0.3993
      48               

3.5.2.4.1 Ergebnisse Levene-Test (Varianzhomogenität)

# Ergebnisse in Liste schreiben
results_levene <- tibble(Ebene = c("Staat", 
                                   "Kanton",
                                   "Gemeinde"),
                         F_Wert = c(
                           car::leveneTest(diff_state ~ rechtsform,
                                           data = df_sub)[1,
                                                          "F value"],
                           car::leveneTest(diff_kanton ~ rechtsform,
                                           data = df_sub)[1,
                                                          "F value"],
                           car::leveneTest(diff_gemeinde ~ rechtsform,
                                           data = df_sub)[1,
                                                          "F value"]),
                         p_Wert = c(car::leveneTest(diff_state ~ rechtsform,
                                                    data = df_sub)[1,
                                                                   "Pr(>F)"],
                                    car::leveneTest(diff_kanton ~ rechtsform,
                                                    data = df_sub)[1,
                                                                   "Pr(>F)"],
                                    car::leveneTest(diff_gemeinde ~ rechtsform,
                                                    data = df_sub)[1,
                                                                   "Pr(>F)"]))

# Tabelle anzeigen
print(results_levene) 

# A tibble: 3 × 3
  Ebene    F_Wert p_Wert
  <chr>     <dbl>  <dbl>
1 Staat     1.35   0.251
2 Kanton    0.641  0.427
3 Gemeinde  0.723  0.399

3.5.2.5 T-Test

t.test(diff_state ~ rechtsform, data = df_sub, var.equal = TRUE)

    Two Sample t-test

data:  diff_state by rechtsform
t = 2.6654, df = 48, p-value = 0.01044
alternative hypothesis: true difference in means between group Fakultatives Referendum and group Volksinitiative is not equal to 0
95 percent confidence interval:
  2.46122 17.57714
sample estimates:
mean in group Fakultatives Referendum         mean in group Volksinitiative 
                             2.395285                             -7.623895 

#t.test(diff_kanton ~ rechtsform, data = df_sub, var.equal = TRUE)
t.test(diff_gemeinde ~ rechtsform, data = df_sub, var.equal = TRUE)

    Two Sample t-test

data:  diff_gemeinde by rechtsform
t = 2.6503, df = 48, p-value = 0.01086
alternative hypothesis: true difference in means between group Fakultatives Referendum and group Volksinitiative is not equal to 0
95 percent confidence interval:
  2.761337 20.119384
sample estimates:
mean in group Fakultatives Referendum         mean in group Volksinitiative 
                             6.398941                             -5.041420 

3.5.2.5.1 Ergebnisse t-Test

# Ergebnisse in Liste schreiben
results_ttest <- tibble(Ebene = c("Staat",
                                  "Gemeinde"),
                        t_Wert = c(t.test(diff_state ~ rechtsform,
                                          data = df_sub,
                                          var.equal = TRUE)$statistic,
                                   t.test(diff_gemeinde ~ rechtsform,
                                          data = df_sub,
                                          var.equal = TRUE)$statistic),
                        df = c(t.test(diff_state ~ rechtsform,
                                      data = df_sub,
                                      var.equal = TRUE)$parameter,
                               t.test(diff_gemeinde ~ rechtsform,
                                      data = df_sub,
                                     var.equal = TRUE)$parameter),
                        p_Wert = c(t.test(diff_state ~ rechtsform,
                                          data = df_sub,
                                          var.equal = TRUE)$p.value,
                                   t.test(diff_gemeinde ~ rechtsform,
                                          data = df_sub,
                                          var.equal = TRUE)$p.value),
                        CI_lower = c(t.test(diff_state ~ rechtsform,
                                            data = df_sub,
                                            var.equal = TRUE)$conf.int[1],
                                     t.test(diff_gemeinde ~ rechtsform,
                                            data = df_sub,
                                            var.equal = TRUE)$conf.int[1]),
                        CI_upper = c(t.test(diff_state ~ rechtsform,
                                            data = df_sub,
                                            var.equal = TRUE)$conf.int[2],
                                     t.test(diff_gemeinde ~ rechtsform,
                                            data = df_sub,
                                            var.equal = TRUE)$conf.int[2]),
                        mean_FR = c(t.test(diff_state ~ rechtsform,
                                           data = df_sub,
                                           var.equal = TRUE)$estimate[1],
                                    t.test(diff_gemeinde ~ rechtsform,
                                           data = df_sub,
                                           var.equal = TRUE)$estimate[1]),
                        mean_VI = c(t.test(diff_state ~ rechtsform,
                                           data = df_sub,
                                           var.equal = TRUE)$estimate[2],
                                    t.test(diff_gemeinde ~ rechtsform,
                                           data = df_sub,
                                           var.equal = TRUE)$estimate[2]))

print(results_ttest)

# A tibble: 2 × 8
  Ebene    t_Wert    df p_Wert CI_lower CI_upper mean_FR mean_VI
  <chr>     <dbl> <dbl>  <dbl>    <dbl>    <dbl>   <dbl>   <dbl>
1 Staat      2.67    48 0.0104     2.46     17.6    2.40   -7.62
2 Gemeinde   2.65    48 0.0109     2.76     20.1    6.40   -5.04

#view(results_ttest)

3.5.2.6 Mann-Whitney-U-Test / Wilcox

# Wilcoxon-Test durchführen
wilcox_kanton <- wilcox.test(diff_kanton ~ rechtsform,
                             data = df_sub,
                             exact = TRUE)

# Mediane berechnen
mediane <- df_sub %>%
  group_by(rechtsform) %>%
  summarise(Median = median(diff_kanton)) %>%
  arrange(rechtsform)

3.5.2.6.1 Ergebnisse Mann-Whitney-U-Test / Wilcox

# Ergebnisse als Liste schreiben
results_wilcox <- tibble(Ebene = "Kanton",
                         Test = "Wilcoxon-Test",
                         Teststatistik = wilcox_kanton$statistic,
                         p_Wert = wilcox_kanton$p.value,
                         Median_FR = mediane$Median[mediane$rechtsform ==
                                                      "Fakultatives Referendum"],
                         Median_VI = mediane$Median[mediane$rechtsform ==
                                                      "Volksinitiative"])

print(results_wilcox)

# A tibble: 1 × 6
  Ebene  Test          Teststatistik        p_Wert Median_FR Median_VI
  <chr>  <chr>                 <dbl>         <dbl>     <dbl>     <dbl>
1 Kanton Wilcoxon-Test           576 0.00000000158      10.7     -17.1

# view(results_wilcox)

3.5.2.7 Tables Annahme & Ablehnung(Word)

# Funktion für identische Formatierung
format_table <- function(df) {
  df[[1]] <- as.character(df[[1]])
  df[[3]] <- as.character(df[[3]])
  ft <- flextable(df)
  ft <- theme_vanilla(ft)
  ft <- font(ft, fontname = "Courier New", part = "all")
  ft <- fontsize(ft, size = 8, part = "all")
  ft <- colformat_double(ft, digits = 2)
  #ft <- colformat_double(ft, digits = 1, suffix = "%")
  ft <- width(ft, j = 2, width = 2)
  return(ft)
}

# Tabelle 1: ANGENOMMEN
df1 <- head(angenommen_ohne_ja_parole_50)
ft1 <- format_table(df1)

# Tabelle 2: ABGELEHNT
df2 <- head(abgelehnt_ohne_nein_parole_50)
ft2 <- format_table(df2)


# Word-Dokument erstellen und beide Tabellen einfügen ---
doc <- read_docx()
doc <- body_add_par(doc,
                    "Annahme trotz fehlender Unterstützung durch Parolen",
                    style = "heading 1")
doc <- body_add_flextable(doc,
                          ft1)
doc <- body_add_par(doc, "") # Leerzeile
doc <- body_add_par(doc,
                    "Ablehnung trotz fehlender Unterstützung durch Parolen",
                    style = "heading 1")
doc <- body_add_flextable(doc,
                          ft2)


# Speichern 
print(doc, target = "result/Annahme_Ablehnung.docx")

3.5.2.8 Tables Varianz (Word)

# Funktion für identische Formatierung
format_table <- function(df) {
  df[[1]] <- as.character(df[[1]])
  ft <- flextable(df)
  ft <- theme_vanilla(ft)
  ft <- font(ft, fontname = "Courier New", part = "all")
  ft <- fontsize(ft, size = 8, part = "all")
  ft <- colformat_double(ft, digits = 2)
  #ft <- colformat_double(ft, digits = 1, suffix = "%")
  ft <- width(ft, j = 2, width = 2)
  return(ft)
}


# Tabelle 1: VARIANZ
df1 <- head(summary_stats_v1, 10)
ft1 <- format_table(df1)

# Tabelle 2: VARIANZ Gruppiert nach Rechtsform
df2 <- head(summary_stats_v2, 10)
ft2 <- format_table(df2)


# Word-Dokument erstellen und beide Tabellen einfügen ---
doc <- read_docx()
doc <- body_add_par(doc,
                    "Mittlere Abweichung der Parolen vom Volksentscheid - Mit Standardabweichung",
                    style = "heading 1")
doc <- body_add_flextable(doc,
                          ft1)
doc <- body_add_par(doc, "") # Leerzeile
doc <- body_add_par(doc,
                    "Mittlere Abweichung der Parolen vom Volksentscheid - Mit Standardabweichung. Gruppiert nach Rechtsform",
                    style = "heading 1")
doc <- body_add_flextable(doc,
                          ft2)

# Speichern 
print(doc, target = "result/Varianz.docx")

3.5.2.9 Plots

##################################
##################################
#### ANGENOMMEN
# Daten filtern und Bedingung setzen
df <- voting_5y_final %>%
  mutate(annahme = as.numeric(annahme),
         state_parole_Ja = as.numeric(state_parole_Ja),
         kt_parole_Ja = as.numeric(kt_parole_Ja),
         gemeinde_parole_Ja = as.numeric(gemeinde_parole_Ja)) %>%
  filter(annahme == 1) %>%
  # Nur angenommene Abstimmungen
  mutate(keine_ja_parole_50 = (state_parole_Ja <= 50) &
                              (kt_parole_Ja <= 50) &
                              (gemeinde_parole_Ja <= 50)) %>%
  select(anr,
         titel_kurz_d,
         state_parole_Ja,
         kt_parole_Ja,
         gemeinde_parole_Ja,
         keine_ja_parole_50)

# Daten ins long format
df_long <- df %>%
  pivot_longer(cols = c(state_parole_Ja,
                        kt_parole_Ja,
                        gemeinde_parole_Ja),
               names_to = "Ebene",
               values_to = "Ja_Parole")

# Farbspalte für Hervorhebung
df_long <- df_long %>%
  mutate(highlight = ifelse(keine_ja_parole_50,
                            "keine Mehrheit",
                            "mind. 1 Mehrheit"))

# Plot
ggplot(df_long,
       aes(x = reorder(titel_kurz_d,
                       anr),
           y = Ja_Parole,
           fill = Ebene,
           alpha = highlight)) +
  geom_bar(stat = "identity",
           position = "dodge",
           color = "black") +
  geom_hline(yintercept = 50,
             linetype = "dashed",
             color = "red") +
  scale_alpha_manual(values = c("keine Mehrheit" = 1,
                                "mind. 1 Mehrheit" = 0.5)) +
  labs(x = "Abstimmung",
       y = "Ja-Parole (%)",
       fill = "Ebene",
       alpha = "Hervorhebung",
       title = "Ja-Parole-Anteile bei angenommenen Abstimmungen") +
  theme(axis.text.x = element_text(angle = 45,
                                   hjust = 1))

##################################
##################################
#### ABGELEHNT
# Daten filtern und Bedingung setzen
df_negativ <- voting_5y_final %>%
  mutate(annahme = as.numeric(annahme),
         state_parole_Ja = as.numeric(state_parole_Ja),
         kt_parole_Ja = as.numeric(kt_parole_Ja),
         gemeinde_parole_Ja = as.numeric(gemeinde_parole_Ja)) %>%
  filter(annahme == 0) %>%  
  # Nur abgelehnte Abstimmungen
  mutate(ja_parole_mehrheit = (state_parole_Ja > 50) |
                              (kt_parole_Ja > 50) |
                              (gemeinde_parole_Ja > 50)) %>%
  select(anr,
         titel_kurz_d,
         state_parole_Ja,
         kt_parole_Ja,
         gemeinde_parole_Ja,
         ja_parole_mehrheit)

# Daten ins long format
df_negativ_long <- df_negativ %>%
  pivot_longer(cols = c(state_parole_Ja,
                        kt_parole_Ja,
                        gemeinde_parole_Ja),
               names_to = "Ebene",
               values_to = "Ja_Parole") %>%
  mutate(highlight = ifelse(ja_parole_mehrheit,
                            "Mehrheit Ja-Parole",
                            "Keine Mehrheit"))

# Plot
ggplot(df_negativ_long,
       aes(x = reorder(titel_kurz_d,
                       anr),
           y = Ja_Parole,
           fill = Ebene,
           alpha = highlight)) +
  geom_bar(stat = "identity",
           position = "dodge",
           color = "black") +
  geom_hline(yintercept = 50,
             linetype = "dashed",
             color = "red") +
  scale_alpha_manual(values = c("Mehrheit Ja-Parole" = 1,
                                "Keine Mehrheit" = 0.5)) +
  labs(x = "Abstimmung",
       y = "Ja-Parole (%)",
       fill = "Ebene",
       alpha = "Hervorhebung",
       title = "Abgelehnte Abstimmungen mit Ja-Parolen-Mehrheit") +
  theme(axis.text.x = element_text(angle = 45,
                                   hjust = 1))

3.5.3 Korrelation

str(voting_5y_final)

tibble [52 × 41] (S3: tbl_df/tbl/data.frame)
 $ anr                  : num [1:52] 626 627 628 629 630 631 632 633 634 635 ...
 $ year                 : num [1:52] 2019 2019 2019 2020 2020 ...
 $ annahme              : num [1:52] 0 1 1 0 1 0 0 0 1 1 ...
 $ state_parole_Nein    : num [1:52] 64.8 20.1 24.6 66 24.6 ...
 $ state_parole_Ja      : num [1:52] 34.8 54.9 74.6 33.6 73.8 ...
 $ state_parole_Keine   : num [1:52] 0.41 25 0.82 0.41 1.64 ...
 $ kt_parole_Nein       : num [1:52] 71.72 4.83 16.55 70.63 17.48 ...
 $ kt_parole_Ja         : num [1:52] 25.5 75.9 80.7 25.9 79 ...
 $ kt_parole_Keine      : num [1:52] 2.76 19.31 2.76 3.5 3.5 ...
 $ gemeinde_parole_Nein : num [1:52] 53.89 16.74 8.92 54.56 8.76 ...
 $ gemeinde_parole_Ja   : num [1:52] 43.7 71.1 87.7 42.5 86.9 ...
 $ gemeinde_parole_Keine: num [1:52] 2.4 12.2 3.38 2.98 4.29 ...
 $ titel_kurz_d         : chr [1:52] "Zersiedelungsinitiative" "Steuerreform und AHV-Finanzierung (STAF)" "Umsetzung der EU-Waffenrichtlinie" "Initiative «Mehr bezahlbare Wohnungen»" ...
 $ dep                  : Factor w/ 8 levels "EDA","EDI","EJPD",..: 3 2 2 3 2 3 2 2 2 2 ...
 $ rechtsform           : Factor w/ 5 levels "Obligatorisches Referendum",..: 3 2 2 3 2 3 2 2 2 2 ...
 $ inserate_total       : num [1:52] 290 774 364 275 25 ...
 $ inserate_je_ausgabe  : num [1:52] 0.15 0.4 0.19 0.14 0.01 0.34 0.56 0.02 0.12 0.11 ...
 $ inserate_ja          : num [1:52] 15 760 252 41 17 228 288 6 35 177 ...
 $ inserate_nein        : num [1:52] 258 5 102 234 4 422 780 26 196 19 ...
 $ inserate_neutral     : num [1:52] 17 9 10 0 4 8 5 2 1 15 ...
 $ mediares_tot         : num [1:52] 312 455 344 253 249 636 266 172 264 306 ...
 $ mediaton_tot         : num [1:52] -14 16 26 0 37 -35 2 -4 27 13 ...
 $ nrja                 : num [1:52] 37 112 120 56 121 53 117 132 129 123 ...
 $ nrnein               : num [1:52] 143 67 69 140 67 142 71 62 66 68 ...
 $ srja                 : num [1:52] 3 39 34 13 30 5 28 25 31 33 ...
 $ srnein               : num [1:52] 34 4 6 30 12 37 16 17 11 10 ...
 $ bet                  : num [1:52] 37.9 43.7 43.9 41.7 41.7 ...
 $ leer                 : num [1:52] 23068 49337 23110 28176 31597 ...
 $ ungultig             : num [1:52] 7116 8477 7687 6661 6769 ...
 $ gultig               : num [1:52] 2028754 2321604 2356154 2244071 2241395 ...
 $ volkja_proz          : num [1:52] 36.3 66.4 63.7 43 63.1 ...
 $ inserate_ja_pct      : num [1:52] 5.17 98.19 69.23 14.91 68 ...
 $ inserate_nein_pct    : num [1:52] 88.966 0.646 28.022 85.091 16 ...
 $ inserate_neutral_pct : num [1:52] 5.86 1.16 2.75 0 16 ...
 $ nrja_pct             : num [1:52] 20.6 62.6 63.5 28.6 64.4 ...
 $ nrnein_pct           : num [1:52] 79.4 37.4 36.5 71.4 35.6 ...
 $ srja_pct             : num [1:52] 8.11 90.7 85 30.23 71.43 ...
 $ srnein_pct           : num [1:52] 91.9 9.3 15 69.8 28.6 ...
 $ diff_state           : num [1:52] -1.5 -11.46 10.85 -9.34 10.68 ...
 $ diff_kanton          : num [1:52] -10.82 9.48 16.95 -17.08 15.93 ...
 $ diff_gemeinde        : num [1:52] 7.365 4.685 23.953 -0.496 23.856 ...

# Auswahl relevanter numerischer Variablen
subset_corr <- voting_5y_final %>%
  select(annahme,
         volkja_proz,
         diff_state,
         diff_kanton,
         diff_gemeinde,
         state_parole_Ja,
         kt_parole_Ja,
         gemeinde_parole_Ja,
         inserate_total,
         inserate_ja_pct,
         mediares_tot,
         mediaton_tot,
         bet,
         nrja_pct,
         srja_pct)



# Erste Visualisierung: Streudiagrammmatrix
pairs(subset_corr, main = "Streudiagrammmatrix der ausgewählten Variablen")

# Prüfung auf Normalverteilung
subset_corr_long <- pivot_longer(subset_corr, everything(), names_to = "Variable", values_to = "Wert")

# Histogramme
ggplot(subset_corr_long, aes(x = Wert)) +
  geom_histogram(bins = 10, fill = "steelblue", color = "black") +
  facet_wrap(~ Variable, scales = "free") +
  theme_minimal() +
  labs(title = "Histogramme ausgewählter Variablen")

# QQ-Plots
ggplot(subset_corr_long, aes(sample = Wert)) +
  stat_qq() +
  stat_qq_line() +
  facet_wrap(~ Variable, scales = "free") +
  theme_minimal() +
  labs(title = "QQ-Plots der ausgewählten Variablen")

# Shapiro-Wilk-Test für alle Variablen
apply(subset_corr, 2, shapiro.test)

$annahme

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.63462, p-value = 3.991e-10


$volkja_proz

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.98521, p-value = 0.7613


$diff_state

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.98555, p-value = 0.7762


$diff_kanton

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.96748, p-value = 0.1649


$diff_gemeinde

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.95869, p-value = 0.06865


$state_parole_Ja

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.91076, p-value = 0.0008678


$kt_parole_Ja

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.91807, p-value = 0.001592


$gemeinde_parole_Ja

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.92065, p-value = 0.001982


$inserate_total

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.86025, p-value = 0.0001923


$inserate_ja_pct

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.89545, p-value = 0.001638


$mediares_tot

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.90343, p-value = 0.0004819


$mediaton_tot

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.98094, p-value = 0.5668


$bet

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.90901, p-value = 0.0007528


$nrja_pct

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.95562, p-value = 0.0506


$srja_pct

    Shapiro-Wilk normality test

data:  newX[, i]
W = 0.90134, p-value = 0.0004091

3.5.3.0.1 Ergebnisse Shapiro-Wilk-Test

# Shapiro-Wilk-Tests für alle Variablen in subset_corr
results_shapiro_vars <- lapply(subset_corr, shapiro.test)

# In Dataframe umwandeln
shapiro_df <- data.frame(
  Variable = names(results_shapiro_vars),
  W_Wert = sapply(results_shapiro_vars,
                  function(x) round(x$statistic, 5)),
  p_Wert = sapply(results_shapiro_vars,
                  function(x) signif(x$p.value, 5)),
  Normalverteilung = sapply(results_shapiro_vars,
                            function(x) if (x$p.value < 0.05) "Nein" else "Ja"))

# print/view
print(shapiro_df)

                               Variable  W_Wert     p_Wert Normalverteilung
annahme.W                       annahme 0.63462 3.9911e-10             Nein
volkja_proz.W               volkja_proz 0.98521 7.6132e-01               Ja
diff_state.W                 diff_state 0.98555 7.7618e-01               Ja
diff_kanton.W               diff_kanton 0.96748 1.6489e-01               Ja
diff_gemeinde.W           diff_gemeinde 0.95869 6.8653e-02               Ja
state_parole_Ja.W       state_parole_Ja 0.91076 8.6780e-04             Nein
kt_parole_Ja.W             kt_parole_Ja 0.91807 1.5918e-03             Nein
gemeinde_parole_Ja.W gemeinde_parole_Ja 0.92065 1.9821e-03             Nein
inserate_total.W         inserate_total 0.86025 1.9234e-04             Nein
inserate_ja_pct.W       inserate_ja_pct 0.89545 1.6378e-03             Nein
mediares_tot.W             mediares_tot 0.90343 4.8194e-04             Nein
mediaton_tot.W             mediaton_tot 0.98094 5.6678e-01               Ja
bet.W                               bet 0.90901 7.5282e-04             Nein
nrja_pct.W                     nrja_pct 0.95562 5.0600e-02               Ja
srja_pct.W                     srja_pct 0.90134 4.0909e-04             Nein

# view(shapiro_df)

3.5.3.1 Korrelationsmatrix berechnen

# # Pearson-Korrelation (für normalverteilte Variablen)
# cor_matrix_pearson <- cor(subset_corr, use = "complete.obs", method = "pearson")
# print(round(cor_matrix_pearson, 2))

# Spearman-Korrelation (robuster bei Nicht-Normalverteilung)
cor_matrix_spearman <- cor(subset_corr, use = "complete.obs", method = "spearman")
print(round(cor_matrix_spearman, 2))

                   annahme volkja_proz diff_state diff_kanton diff_gemeinde
annahme               1.00        0.85      -0.17        0.12          0.00
volkja_proz           0.85        1.00      -0.15        0.14          0.14
diff_state           -0.17       -0.15       1.00        0.82          0.70
diff_kanton           0.12        0.14       0.82        1.00          0.53
diff_gemeinde         0.00        0.14       0.70        0.53          1.00
state_parole_Ja       0.55        0.65       0.56        0.75          0.50
kt_parole_Ja          0.50        0.60       0.55        0.83          0.44
gemeinde_parole_Ja    0.47        0.64       0.39        0.39          0.78
inserate_total       -0.40       -0.17       0.22        0.04          0.20
inserate_ja_pct       0.38        0.44       0.11        0.47         -0.06
mediares_tot          0.04        0.16       0.02       -0.06          0.12
mediaton_tot          0.57        0.68       0.25        0.37          0.46
bet                  -0.16       -0.23       0.05       -0.12         -0.06
nrja_pct              0.53        0.53       0.40        0.62          0.43
srja_pct              0.59        0.61       0.27        0.57          0.31
                   state_parole_Ja kt_parole_Ja gemeinde_parole_Ja
annahme                       0.55         0.50               0.47
volkja_proz                   0.65         0.60               0.64
diff_state                    0.56         0.55               0.39
diff_kanton                   0.75         0.83               0.39
diff_gemeinde                 0.50         0.44               0.78
state_parole_Ja               1.00         0.93               0.72
kt_parole_Ja                  0.93         1.00               0.63
gemeinde_parole_Ja            0.72         0.63               1.00
inserate_total               -0.07        -0.06               0.11
inserate_ja_pct               0.42         0.59               0.14
mediares_tot                  0.02        -0.01               0.19
mediaton_tot                  0.65         0.57               0.74
bet                          -0.10        -0.25              -0.11
nrja_pct                      0.78         0.71               0.56
srja_pct                      0.74         0.70               0.52
                   inserate_total inserate_ja_pct mediares_tot mediaton_tot
annahme                     -0.40            0.38         0.04         0.57
volkja_proz                 -0.17            0.44         0.16         0.68
diff_state                   0.22            0.11         0.02         0.25
diff_kanton                  0.04            0.47        -0.06         0.37
diff_gemeinde                0.20           -0.06         0.12         0.46
state_parole_Ja             -0.07            0.42         0.02         0.65
kt_parole_Ja                -0.06            0.59        -0.01         0.57
gemeinde_parole_Ja           0.11            0.14         0.19         0.74
inserate_total               1.00           -0.05         0.59         0.12
inserate_ja_pct             -0.05            1.00         0.04         0.38
mediares_tot                 0.59            0.04         1.00         0.24
mediaton_tot                 0.12            0.38         0.24         1.00
bet                          0.13           -0.32         0.32        -0.02
nrja_pct                    -0.19            0.48         0.01         0.56
srja_pct                    -0.07            0.57         0.06         0.57
                     bet nrja_pct srja_pct
annahme            -0.16     0.53     0.59
volkja_proz        -0.23     0.53     0.61
diff_state          0.05     0.40     0.27
diff_kanton        -0.12     0.62     0.57
diff_gemeinde      -0.06     0.43     0.31
state_parole_Ja    -0.10     0.78     0.74
kt_parole_Ja       -0.25     0.71     0.70
gemeinde_parole_Ja -0.11     0.56     0.52
inserate_total      0.13    -0.19    -0.07
inserate_ja_pct    -0.32     0.48     0.57
mediares_tot        0.32     0.01     0.06
mediaton_tot       -0.02     0.56     0.57
bet                 1.00    -0.01    -0.10
nrja_pct           -0.01     1.00     0.86
srja_pct           -0.10     0.86     1.00

#Visualisierung der Korrelationsmatrix
corrplot(cor_matrix_spearman, method = "color", addCoef.col = "black", tl.col = "black")

# #Visualisierung der Korrelationsmatrix als Heatmap
# melted_cor <- melt(round(cor_matrix_spearman, 2))
# ggplot(data = melted_cor,
#        aes(x=Var1,
#            y=Var2,
#            fill=value)) +
#   geom_tile() +
#   geom_text(aes(label = value),
#             size = 4) +
#   scale_fill_gradient2(low = "blue",
#                        high = "red", 
#                        limit = c(-1,1),
#                        name="Correlation") +
#   theme(axis.title.x = element_blank(),
#         axis.title.y = element_blank(),
#         panel.background = element_blank())


# #Visualisierung der Korrelationsmatrix mit ggcorrplot
# ggcorrplot(cor_matrix_spearman, lab = TRUE)


# Signifikanz einzelner Korrelationen prüfen
# cor.test(voting_5y_final$diff_state, voting_5y_final$volkja_proz, method = "pearson")
cor.test(voting_5y_final$diff_kanton, voting_5y_final$inserate_ja_pct, method = "spearman")

    Spearman's rank correlation rho

data:  voting_5y_final$diff_kanton and voting_5y_final$inserate_ja_pct
S = 5257.8, p-value = 0.002671
alternative hypothesis: true rho is not equal to 0
sample estimates:
      rho 
0.4678374 

# Zielvariablen
target_vars <- c("annahme",
                 "volkja_proz")

# Numerische Variablen im df ohne Zielvariablen
compare_vars <- setdiff(names(subset_corr),
                        target_vars)

# Kombis von Zielvariable und Vergleichsvariablen testen
cor_test_result <- expand_grid(target = target_vars,
                               compare_to = compare_vars) %>%
  mutate(test = map2(target,
                     compare_to,
                     ~ cor.test(subset_corr[[.x]],
                                subset_corr[[.y]],
                                method = "spearman")),
         rho = map_dbl(test, ~ .x$estimate),
         p_value = map_dbl(test, ~ .x$p.value)) %>%
  select(target,
         compare_to,
         rho,
         p_value)

# Ergebnis anzeigen
print(cor_test_result) %>% print(n=Inf)

# A tibble: 26 × 4
   target  compare_to              rho    p_value
   <chr>   <chr>                 <dbl>      <dbl>
 1 annahme diff_state         -0.267   0.0554    
 2 annahme diff_kanton         0       1         
 3 annahme diff_gemeinde      -0.00257 0.986     
 4 annahme state_parole_Ja     0.471   0.000428  
 5 annahme kt_parole_Ja        0.413   0.00235   
 6 annahme gemeinde_parole_Ja  0.491   0.000219  
 7 annahme inserate_total     -0.398   0.0122    
 8 annahme inserate_ja_pct     0.384   0.0158    
 9 annahme mediares_tot        0.140   0.322     
10 annahme mediaton_tot        0.573   0.00000885
# ℹ 16 more rows
# A tibble: 26 × 4
   target      compare_to              rho     p_value
   <chr>       <chr>                 <dbl>       <dbl>
 1 annahme     diff_state         -0.267   0.0554     
 2 annahme     diff_kanton         0       1          
 3 annahme     diff_gemeinde      -0.00257 0.986      
 4 annahme     state_parole_Ja     0.471   0.000428   
 5 annahme     kt_parole_Ja        0.413   0.00235    
 6 annahme     gemeinde_parole_Ja  0.491   0.000219   
 7 annahme     inserate_total     -0.398   0.0122     
 8 annahme     inserate_ja_pct     0.384   0.0158     
 9 annahme     mediares_tot        0.140   0.322      
10 annahme     mediaton_tot        0.573   0.00000885 
11 annahme     bet                -0.0694  0.625      
12 annahme     nrja_pct            0.578   0.00000712 
13 annahme     srja_pct            0.526   0.0000624  
14 volkja_proz diff_state         -0.272   0.0510     
15 volkja_proz diff_kanton         0.0593  0.676      
16 volkja_proz diff_gemeinde       0.0827  0.560      
17 volkja_proz state_parole_Ja     0.563   0.0000141  
18 volkja_proz kt_parole_Ja        0.550   0.0000239  
19 volkja_proz gemeinde_parole_Ja  0.619   0.00000100 
20 volkja_proz inserate_total     -0.167   0.311      
21 volkja_proz inserate_ja_pct     0.438   0.00534    
22 volkja_proz mediares_tot        0.223   0.111      
23 volkja_proz mediaton_tot        0.657   0.000000126
24 volkja_proz bet                -0.113   0.425      
25 volkja_proz nrja_pct            0.633   0.000000471
26 volkja_proz srja_pct            0.612   0.00000144 

cor_test_result_filtered <- cor_test_result %>% 
  filter(abs(rho) > 0.5,
         p_value < 0.05) %>%
  arrange(target,
          desc(abs(rho)))


print(cor_test_result_filtered)

# A tibble: 9 × 4
  target      compare_to           rho     p_value
  <chr>       <chr>              <dbl>       <dbl>
1 annahme     nrja_pct           0.578 0.00000712 
2 annahme     mediaton_tot       0.573 0.00000885 
3 annahme     srja_pct           0.526 0.0000624  
4 volkja_proz mediaton_tot       0.657 0.000000126
5 volkja_proz nrja_pct           0.633 0.000000471
6 volkja_proz gemeinde_parole_Ja 0.619 0.00000100 
7 volkja_proz srja_pct           0.612 0.00000144 
8 volkja_proz state_parole_Ja    0.563 0.0000141  
9 volkja_proz kt_parole_Ja       0.550 0.0000239  

# view(cor_test_result_filtered)


# VIF mit allen Variablen
# mod_vif <- lm(volkja_proz ~ 
#                 diff_state + diff_kanton + diff_gemeinde +
#                 state_parole_Ja + kt_parole_Ja + gemeinde_parole_Ja +
#                 inserate_total + inserate_ja_pct + mediares_tot + mediaton_tot +
#                 bet + nrja_pct + srja_pct,
#               data = voting_5y_final)
# vif(mod_vif)

#alias(mod_vif)

mod_vif_fixed <- lm(volkja_proz ~
                      # diff_state + diff_kanton + diff_gemeinde +
                      state_parole_Ja + kt_parole_Ja + gemeinde_parole_Ja +
                      inserate_total + inserate_ja_pct + mediares_tot +
                      mediaton_tot + bet + nrja_pct + srja_pct,
                    data = voting_5y_final)

vif(mod_vif_fixed)

   state_parole_Ja       kt_parole_Ja gemeinde_parole_Ja     inserate_total 
         19.224599          14.965330           7.935408           1.852499 
   inserate_ja_pct       mediares_tot       mediaton_tot                bet 
          3.292273           2.017894           3.732611           1.865852 
          nrja_pct           srja_pct 
         11.130373          11.048177 

3.6 Modelllierung

3.6.1 Lineare Regression

3.6.1.1 Modelle erstellen

#SR und NR als Parlament zusammenfassen
voting_5y_final <- voting_5y_final %>%
  mutate(parliament_ja_avg = (nrja_pct + srja_pct) / 2)

# Modell state
lm_state <- lm(volkja_proz ~ state_parole_Ja +
                 inserate_total + inserate_ja_pct +
                 mediares_tot + mediaton_tot +
                 bet,
               data = voting_5y_final)
summary(lm_state)

Call:
lm(formula = volkja_proz ~ state_parole_Ja + inserate_total + 
    inserate_ja_pct + mediares_tot + mediaton_tot + bet, data = voting_5y_final)

Residuals:
    Min      1Q  Median      3Q     Max 
-13.082  -4.614  -1.985   4.665  19.641 

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)     41.28542   11.35141   3.637 0.000959 ***
state_parole_Ja  0.28154    0.12853   2.190 0.035895 *  
inserate_total  -0.01122    0.00528  -2.125 0.041438 *  
inserate_ja_pct  0.04133    0.05027   0.822 0.417080    
mediares_tot     0.02079    0.01183   1.758 0.088300 .  
mediaton_tot     0.24274    0.11803   2.057 0.047947 *  
bet             -0.19954    0.18090  -1.103 0.278224    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 8.325 on 32 degrees of freedom
  (13 Beobachtungen als fehlend gelöscht)
Multiple R-squared:  0.6218,    Adjusted R-squared:  0.5509 
F-statistic:  8.77 on 6 and 32 DF,  p-value: 1.111e-05

# Modell kanton
lm_kanton<- lm(volkja_proz ~ kt_parole_Ja +
                 inserate_total + inserate_ja_pct +
                 mediares_tot + mediaton_tot +
                 bet,
               data = voting_5y_final)
summary(lm_kanton)

Call:
lm(formula = volkja_proz ~ kt_parole_Ja + inserate_total + inserate_ja_pct + 
    mediares_tot + mediaton_tot + bet, data = voting_5y_final)

Residuals:
     Min       1Q   Median       3Q      Max 
-13.0188  -5.9105  -0.9957   5.7537  21.3344 

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)    
(Intercept)     47.069903  10.742731   4.382 0.000119 ***
kt_parole_Ja     0.168110   0.093562   1.797 0.081814 .  
inserate_total  -0.010769   0.005387  -1.999 0.054165 .  
inserate_ja_pct  0.017955   0.055925   0.321 0.750253    
mediares_tot     0.022403   0.012120   1.848 0.073797 .  
mediaton_tot     0.319524   0.104095   3.070 0.004346 ** 
bet             -0.211499   0.184686  -1.145 0.260627    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 8.508 on 32 degrees of freedom
  (13 Beobachtungen als fehlend gelöscht)
Multiple R-squared:  0.605, Adjusted R-squared:  0.5309 
F-statistic: 8.168 on 6 and 32 DF,  p-value: 2.124e-05

# Modell gemeinde
lm_gemeinde<- lm(volkja_proz ~ gemeinde_parole_Ja +
                   inserate_total + inserate_ja_pct +
                   mediares_tot + mediaton_tot +
                   bet,
               data = voting_5y_final)
summary(lm_gemeinde)

Call:
lm(formula = volkja_proz ~ gemeinde_parole_Ja + inserate_total + 
    inserate_ja_pct + mediares_tot + mediaton_tot + bet, data = voting_5y_final)

Residuals:
    Min      1Q  Median      3Q     Max 
-13.396  -5.584  -1.657   5.364  23.262 

Coefficients:
                    Estimate Std. Error t value Pr(>|t|)   
(Intercept)        40.384143  13.543873   2.982  0.00544 **
gemeinde_parole_Ja  0.163433   0.111757   1.462  0.15338   
inserate_total     -0.011175   0.005491  -2.035  0.05019 . 
inserate_ja_pct     0.078187   0.052700   1.484  0.14769   
mediares_tot        0.019171   0.012325   1.555  0.12966   
mediaton_tot        0.251002   0.145997   1.719  0.09523 . 
bet                -0.118044   0.200379  -0.589  0.55993   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 8.643 on 32 degrees of freedom
  (13 Beobachtungen als fehlend gelöscht)
Multiple R-squared:  0.5924,    Adjusted R-squared:  0.516 
F-statistic: 7.751 on 6 and 32 DF,  p-value: 3.381e-05

# Modell parliament
lm_parliament<- lm(volkja_proz ~ parliament_ja_avg +
                     inserate_total + inserate_ja_pct +
                     mediares_tot + mediaton_tot +
                     bet,
               data = voting_5y_final)
summary(lm_parliament)

Call:
lm(formula = volkja_proz ~ parliament_ja_avg + inserate_total + 
    inserate_ja_pct + mediares_tot + mediaton_tot + bet, data = voting_5y_final)

Residuals:
    Min      1Q  Median      3Q     Max 
-15.954  -5.097  -1.309   5.279  20.677 

Coefficients:
                   Estimate Std. Error t value Pr(>|t|)    
(Intercept)       50.850677  10.207919   4.981  2.1e-05 ***
parliament_ja_avg  0.158178   0.082844   1.909  0.06522 .  
inserate_total    -0.009622   0.005372  -1.791  0.08273 .  
inserate_ja_pct    0.001830   0.059023   0.031  0.97546    
mediares_tot       0.019472   0.012033   1.618  0.11543    
mediaton_tot       0.317515   0.102466   3.099  0.00403 ** 
bet               -0.279232   0.186014  -1.501  0.14313    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 8.458 on 32 degrees of freedom
  (13 Beobachtungen als fehlend gelöscht)
Multiple R-squared:  0.6096,    Adjusted R-squared:  0.5364 
F-statistic: 8.328 on 6 and 32 DF,  p-value: 1.784e-05

3.6.1.2 Kennzahlen extrahieren

model_list <- list(State = lm_state,
                   Kanton = lm_kanton,
                   Gemeinde = lm_gemeinde,
                   Parliament = lm_parliament)

# Funktion zum Extrahieren der Werte
model_stats <- lapply(model_list, function(mod) {
  c(R2 = summary(mod)$r.squared,
    AdjR2 = summary(mod)$adj.r.squared,
    AIC = AIC(mod),
    BIC = BIC(mod))
})


# In Dataframe umwandeln
model_stats_df <- do.call(rbind, model_stats)
print(round(model_stats_df, 3))

              R2 AdjR2     AIC     BIC
State      0.622 0.551 284.261 297.569
Kanton     0.605 0.531 285.961 299.269
Gemeinde   0.592 0.516 287.186 300.495
Parliament 0.610 0.536 285.501 298.810

3.6.1.3 Visualisierung der Modellgüte

# Balkendiagramm für R² und Adjusted R²
df <- as.data.frame(model_stats_df)
df$Model <- rownames(df)
df_melt <- melt(df, id.vars = "Model")

ggplot(df_melt[df_melt$variable %in% c("R2",
                                       "AdjR2"), ],
        aes(x = Model,
            y = value,
            fill = variable)) +
  geom_bar(stat = "identity",
           position = position_dodge()) +
  ylim(0,1) +
  labs(title = "Vergleich der Modellgüte (R² und Adjusted R²)",
       y = "Wert",
       x = "Modell") +
  theme_minimal()

# AIC/BIC Vergleich (niedriger = besser)
ggplot(df_melt[df_melt$variable %in% c("AIC", "BIC"), ],
       aes(x = Model,
           y = value,
           fill = variable)) +
  geom_bar(stat = "identity",
           position = position_dodge()) +
  labs(title = "Vergleich von AIC und BIC der Modelle",
       y = "Wert",
       x = "Modell") +
  theme_minimal()

3.6.2 Logarithmische Regression

3.6.2.1 Daten log-transformieren und bereinigen

voting_5y_final_log <- voting_5y_final %>%
  mutate(log_mediares = log(mediares_tot + 1),
         log_inserate_total = log(inserate_total + 1),
         log_inserate_ja_pct = log(inserate_ja_pct + 1),
         log_inserate_neutral_pct = log(inserate_neutral_pct + 1),
         log_bet = log(bet + 1),
         log_leer = log(leer + 1),
         log_ungultig = log(ungultig + 1),
         log_gultig = log(gultig + 1)) %>%
  drop_na()

3.6.2.2 Multikollinearität via vif() erkennen, bereinigen und Startmodelle erstellen

mod_log_state <- glm(annahme ~ state_parole_Ja + 
                     #kt_parole_Ja + gemeinde_parole_Ja + parliament_ja_avg +
                     log_mediares + log_inserate_total +
                     log_inserate_ja_pct + log_inserate_neutral_pct + log_bet +
                     #log_leer + log_ungultig + log_gultig + 
                     #rechtsform + 
                     dep,
                   data = voting_5y_final_log,
                   family = binomial)
vif(mod_log_state)

                             GVIF Df GVIF^(1/(2*Df))
state_parole_Ja          3.503335  1        1.871720
log_mediares             2.326847  1        1.525401
log_inserate_total       3.128317  1        1.768705
log_inserate_ja_pct      1.988018  1        1.409971
log_inserate_neutral_pct 1.793314  1        1.339147
log_bet                  1.578331  1        1.256316
dep                      3.994563  2        1.413733

mod_log_kanton <- glm(annahme ~  kt_parole_Ja +
                     #state_parole_Ja +gemeinde_parole_Ja + parliament_ja_avg +
                     log_mediares + log_inserate_total +
                     log_inserate_ja_pct + log_inserate_neutral_pct + log_bet +
                     #log_leer + log_ungultig + log_gultig + 
                     #rechtsform + 
                     dep,
                   data = voting_5y_final_log,
                   family = binomial)
vif(mod_log_kanton)

                             GVIF Df GVIF^(1/(2*Df))
kt_parole_Ja             5.122563  1        2.263308
log_mediares             2.491248  1        1.578369
log_inserate_total       2.887225  1        1.699184
log_inserate_ja_pct      1.833897  1        1.354215
log_inserate_neutral_pct 1.584018  1        1.258578
log_bet                  1.295296  1        1.138111
dep                      4.904241  2        1.488137

mod_log_gemeinde <- glm(annahme ~ gemeinde_parole_Ja + 
                            #state_parole_Ja + #kt_parole_Ja + parliament_ja_avg +
                            log_mediares + log_inserate_total +
                            log_inserate_ja_pct + log_inserate_neutral_pct +
                            #log_bet + log_leer + log_ungultig + log_gultig + 
                            #rechtsform +
                            dep,
                            data = voting_5y_final_log,
                            family = binomial)
vif(mod_log_gemeinde)

                              GVIF Df GVIF^(1/(2*Df))
gemeinde_parole_Ja       10.050745  1        3.170291
log_mediares              1.558934  1        1.248573
log_inserate_total        6.965823  1        2.639285
log_inserate_ja_pct       3.753340  1        1.937354
log_inserate_neutral_pct  1.573607  1        1.254435
dep                       5.996269  2        1.564841

mod_log_parliament <- glm(annahme ~ parliament_ja_avg +
                            #state_parole_Ja + #kt_parole_Ja + gemeinde_parole_Ja +
                            log_mediares + log_inserate_total +
                            log_inserate_ja_pct + log_inserate_neutral_pct +
                            #log_bet + log_leer + log_ungultig + log_gultig + 
                            #rechtsform +
                            dep,
                            data = voting_5y_final_log,
                            family = binomial)
vif(mod_log_parliament)

                              GVIF Df GVIF^(1/(2*Df))
parliament_ja_avg        11.224060  1        3.350233
log_mediares              1.952281  1        1.397241
log_inserate_total        2.249792  1        1.499931
log_inserate_ja_pct       1.889262  1        1.374504
log_inserate_neutral_pct  1.491983  1        1.221467
dep                      12.949231  2        1.896972

3.6.2.2.1 Ergebnisse vif()

# VIF-Werte für jedes Modell berechnen
vif_gemeinde   <- vif(mod_log_gemeinde) %>%
  as.data.frame() %>%
  tibble::rownames_to_column("Prädiktor")
vif_kanton     <- vif(mod_log_kanton) %>%
  as.data.frame() %>%
  tibble::rownames_to_column("Prädiktor")
vif_state      <- vif(mod_log_state) %>%
  as.data.frame() %>%
  tibble::rownames_to_column("Prädiktor")
vif_parliament <- vif(mod_log_parliament) %>%
  as.data.frame() %>%
  tibble::rownames_to_column("Prädiktor")

# Modellnamen hinzufügen
vif_gemeinde$Modell   <- "Gemeindeparole"
vif_kanton$Modell     <- "Kantonsparole"
vif_state$Modell      <- "Staatsparole"
vif_parliament$Modell <- "Parlamentsparole"

# Alle zusammenführen
vif_all <- bind_rows(vif_gemeinde, vif_kanton, vif_state, vif_parliament) %>%
  select(Modell, Prädiktor, GVIF, Df, `GVIF^(1/(2*Df))`)

print(vif_all)

             Modell                Prädiktor      GVIF Df GVIF^(1/(2*Df))
1    Gemeindeparole       gemeinde_parole_Ja 10.050745  1        3.170291
2    Gemeindeparole             log_mediares  1.558934  1        1.248573
3    Gemeindeparole       log_inserate_total  6.965823  1        2.639285
4    Gemeindeparole      log_inserate_ja_pct  3.753340  1        1.937354
5    Gemeindeparole log_inserate_neutral_pct  1.573607  1        1.254435
6    Gemeindeparole                      dep  5.996269  2        1.564841
7     Kantonsparole             kt_parole_Ja  5.122563  1        2.263308
8     Kantonsparole             log_mediares  2.491248  1        1.578369
9     Kantonsparole       log_inserate_total  2.887225  1        1.699184
10    Kantonsparole      log_inserate_ja_pct  1.833897  1        1.354215
11    Kantonsparole log_inserate_neutral_pct  1.584018  1        1.258578
12    Kantonsparole                  log_bet  1.295296  1        1.138111
13    Kantonsparole                      dep  4.904241  2        1.488137
14     Staatsparole          state_parole_Ja  3.503335  1        1.871720
15     Staatsparole             log_mediares  2.326847  1        1.525401
16     Staatsparole       log_inserate_total  3.128317  1        1.768705
17     Staatsparole      log_inserate_ja_pct  1.988018  1        1.409971
18     Staatsparole log_inserate_neutral_pct  1.793314  1        1.339147
19     Staatsparole                  log_bet  1.578331  1        1.256316
20     Staatsparole                      dep  3.994563  2        1.413733
21 Parlamentsparole        parliament_ja_avg 11.224060  1        3.350233
22 Parlamentsparole             log_mediares  1.952281  1        1.397241
23 Parlamentsparole       log_inserate_total  2.249792  1        1.499931
24 Parlamentsparole      log_inserate_ja_pct  1.889262  1        1.374504
25 Parlamentsparole log_inserate_neutral_pct  1.491983  1        1.221467
26 Parlamentsparole                      dep 12.949231  2        1.896972

# Tabelle schön ausgeben
kable(vif_all,
      digits = 2,
      caption = "GVIF-Werte der Prädiktoren in den logistischen Regressionsmodellen")

GVIF-Werte der Prädiktoren in den logistischen Regressionsmodellen

Modell	Prädiktor	GVIF	Df	GVIF^(1/(2*Df))
Gemeindeparole	gemeinde_parole_Ja	10.05	1	3.17
Gemeindeparole	log_mediares	1.56	1	1.25
Gemeindeparole	log_inserate_total	6.97	1	2.64
Gemeindeparole	log_inserate_ja_pct	3.75	1	1.94
Gemeindeparole	log_inserate_neutral_pct	1.57	1	1.25
Gemeindeparole	dep	6.00	2	1.56
Kantonsparole	kt_parole_Ja	5.12	1	2.26
Kantonsparole	log_mediares	2.49	1	1.58
Kantonsparole	log_inserate_total	2.89	1	1.70
Kantonsparole	log_inserate_ja_pct	1.83	1	1.35
Kantonsparole	log_inserate_neutral_pct	1.58	1	1.26
Kantonsparole	log_bet	1.30	1	1.14
Kantonsparole	dep	4.90	2	1.49
Staatsparole	state_parole_Ja	3.50	1	1.87
Staatsparole	log_mediares	2.33	1	1.53
Staatsparole	log_inserate_total	3.13	1	1.77
Staatsparole	log_inserate_ja_pct	1.99	1	1.41
Staatsparole	log_inserate_neutral_pct	1.79	1	1.34
Staatsparole	log_bet	1.58	1	1.26
Staatsparole	dep	3.99	2	1.41
Parlamentsparole	parliament_ja_avg	11.22	1	3.35
Parlamentsparole	log_mediares	1.95	1	1.40
Parlamentsparole	log_inserate_total	2.25	1	1.50
Parlamentsparole	log_inserate_ja_pct	1.89	1	1.37
Parlamentsparole	log_inserate_neutral_pct	1.49	1	1.22
Parlamentsparole	dep	12.95	2	1.90

3.6.2.3 stepAIC für Modellauswahl

step_state <- stepAIC(mod_log_state, direction = "both",
                      trace = FALSE)
step_kanton <- stepAIC(mod_log_kanton, direction = "both",
                       trace = FALSE)
step_gemeinde <- stepAIC(mod_log_gemeinde, direction = "both",
                         trace = FALSE)
step_parliament <- stepAIC(mod_log_parliament, direction = "both",
                           trace = FALSE)

3.6.2.4 Modelle vergleichen

3.6.2.4.1 GVIF-Werte

# GVIF-Werte
# Liste aller Modelle
model_list <- list(mod_log_state      = mod_log_state,
                   mod_log_kanton     = mod_log_kanton,
                   mod_log_gemeinde   = mod_log_gemeinde,
                   mod_log_parliament = mod_log_parliament)

# Funktion zur Berechnung und Ausgabe
vif_bandbreite_max <- function(model, model_name) {
  vif_df <- as.data.frame(vif(model))
  range_gvif <- range(vif_df$`GVIF^(1/(2*Df))`)
  bandbreite_gvif <- diff(range_gvif)
  max_gvif <- max(vif_df$`GVIF^(1/(2*Df))`)
  max_gvif_var <- rownames(vif_df)[which.max(vif_df$`GVIF^(1/(2*Df))`)]
  cat("------", model_name, "------\n")
  cat("Bandbreite (Range):",
      round(range_gvif[1], 3), "-", round(range_gvif[2], 3), "\n")
  cat("Bandbreite (Differenz):",
      round(bandbreite_gvif, 3), "\n")
  cat("Höchster GVIF^(1/(2Df)) Wert:",
      round(max_gvif, 3), "(", max_gvif_var, ")\n\n")
}

# Schleife über alle Modelle
for (name in names(model_list)) {
  vif_bandbreite_max(model_list[[name]], name)
}

------ mod_log_state ------
Bandbreite (Range): 1.256 - 1.872 
Bandbreite (Differenz): 0.615 
Höchster GVIF^(1/(2Df)) Wert: 1.872 ( state_parole_Ja )

------ mod_log_kanton ------
Bandbreite (Range): 1.138 - 2.263 
Bandbreite (Differenz): 1.125 
Höchster GVIF^(1/(2Df)) Wert: 2.263 ( kt_parole_Ja )

------ mod_log_gemeinde ------
Bandbreite (Range): 1.249 - 3.17 
Bandbreite (Differenz): 1.922 
Höchster GVIF^(1/(2Df)) Wert: 3.17 ( gemeinde_parole_Ja )

------ mod_log_parliament ------
Bandbreite (Range): 1.221 - 3.35 
Bandbreite (Differenz): 2.129 
Höchster GVIF^(1/(2Df)) Wert: 3.35 ( parliament_ja_avg )

3.6.2.4.2 AIC, Pseudo-R² (McFadden) & AUC

# stepAIC() zu kombinieren
models <- list(State = step_state,
               Kanton = step_kanton,
               Gemeinde = step_gemeinde,
               Parlament = step_parliament)

# # AIC
# sapply(models, AIC)
# 
# # Pseudo-R² (McFadden)
# sapply(models, function(m) round(pR2(m)["McFadden"], 3))
# 
# # AUC
# sapply(models, function(m) {
#   prob <- predict(m, type = "response")
#   roc_obj <- roc(voting_5y_final_log$annahme, prob)
#   round(auc(roc_obj), 3)
# })
 

#  Ergebnisse
AICs <- sapply(models, AIC)
McFadden <- sapply(models, function(m) round(pR2(m)["McFadden"], 3))

fitting null model for pseudo-r2
fitting null model for pseudo-r2
fitting null model for pseudo-r2
fitting null model for pseudo-r2

AUCs <- sapply(models, function(m) {
  prob <- predict(m, type = "response")
  roc_obj <- roc(voting_5y_final_log$annahme, prob)
  round(auc(roc_obj), 3)
})

# Zusammenfassung als Dataframe
summary_df <- data.frame(
  Modell = names(models),
  AIC = round(AICs, 2),
  McFadden_R2 = as.numeric(McFadden),
  AUC = as.numeric(AUCs),
  row.names = NULL
)

# Ausgabe
print(summary_df)

     Modell   AIC McFadden_R2   AUC
1     State 37.98       0.480 0.923
2    Kanton 42.21       0.365 0.878
3  Gemeinde 36.53       0.470 0.918
4 Parlament 40.23       0.438 0.910

# view(summary_df)

3.6.2.5 Odds-ratios und p-Werte interpretieren

exp(coef(step_state))  # Odds Ratios

       (Intercept)    state_parole_Ja       log_mediares log_inserate_total 
      772.96035633         1.15396601        13.09548350         0.15949434 
           log_bet 
        0.01096805 

print(exp(coef(step_state)))

       (Intercept)    state_parole_Ja       log_mediares log_inserate_total 
      772.96035633         1.15396601        13.09548350         0.15949434 
           log_bet 
        0.01096805 

summary(step_state)    # p-Werte und Interpretation

Call:
glm(formula = annahme ~ state_parole_Ja + log_mediares + log_inserate_total + 
    log_bet, family = binomial, data = voting_5y_final_log)

Coefficients:
                   Estimate Std. Error z value Pr(>|z|)   
(Intercept)         6.65023   12.83206   0.518  0.60428   
state_parole_Ja     0.14320    0.05223   2.742  0.00611 **
log_mediares        2.57227    1.48193   1.736  0.08261 . 
log_inserate_total -1.83575    0.65741  -2.792  0.00523 **
log_bet            -4.51277    3.29473  -1.370  0.17078   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 53.834  on 38  degrees of freedom
Residual deviance: 27.981  on 34  degrees of freedom
AIC: 37.981

Number of Fisher Scoring iterations: 6

exp(coef(step_kanton))  # Odds Ratios

       (Intercept)       kt_parole_Ja       log_mediares log_inserate_total 
      0.0001394356       1.0717423606       8.7373072929       0.2911552373 

summary(step_kanton)    # p-Werte und Interpretation

Call:
glm(formula = annahme ~ kt_parole_Ja + log_mediares + log_inserate_total, 
    family = binomial, data = voting_5y_final_log)

Coefficients:
                   Estimate Std. Error z value Pr(>|z|)   
(Intercept)        -8.87791    6.58973  -1.347  0.17790   
kt_parole_Ja        0.06929    0.02353   2.945  0.00323 **
log_mediares        2.16760    1.33060   1.629  0.10330   
log_inserate_total -1.23390    0.48038  -2.569  0.01021 * 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 53.834  on 38  degrees of freedom
Residual deviance: 34.211  on 35  degrees of freedom
AIC: 42.211

Number of Fisher Scoring iterations: 5

exp(coef(step_gemeinde))  # Odds Ratios

        (Intercept)  gemeinde_parole_Ja  log_inserate_total log_inserate_ja_pct 
          0.6098334           1.1170761           0.1805824           3.2693150 

summary(step_gemeinde)    # p-Werte und Interpretation

Call:
glm(formula = annahme ~ gemeinde_parole_Ja + log_inserate_total + 
    log_inserate_ja_pct, family = binomial, data = voting_5y_final_log)

Coefficients:
                    Estimate Std. Error z value Pr(>|z|)  
(Intercept)         -0.49457    3.00979  -0.164   0.8695  
gemeinde_parole_Ja   0.11071    0.04461   2.482   0.0131 *
log_inserate_total  -1.71157    0.72328  -2.366   0.0180 *
log_inserate_ja_pct  1.18458    0.63377   1.869   0.0616 .
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 53.834  on 38  degrees of freedom
Residual deviance: 28.534  on 35  degrees of freedom
AIC: 36.534

Number of Fisher Scoring iterations: 6

exp(coef(step_parliament))  # Odds Ratios

       (Intercept)  parliament_ja_avg log_inserate_total             depEDI 
      4.618938e+03       1.197799e+00       2.988300e-01       8.542105e-07 
           depEJPD 
      2.076312e-04 

summary(step_parliament)    # p-Werte und Interpretation

Call:
glm(formula = annahme ~ parliament_ja_avg + log_inserate_total + 
    dep, family = binomial, data = voting_5y_final_log)

Coefficients:
                     Estimate Std. Error z value Pr(>|z|)  
(Intercept)           8.43792 2770.32195   0.003   0.9976  
parliament_ja_avg     0.18049    0.08315   2.171   0.0300 *
log_inserate_total   -1.20788    0.50756  -2.380   0.0173 *
depEDI              -13.97309 2770.31601  -0.005   0.9960  
depEJPD              -8.47975 2770.31935  -0.003   0.9976  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 53.834  on 38  degrees of freedom
Residual deviance: 30.232  on 34  degrees of freedom
AIC: 40.232

Number of Fisher Scoring iterations: 16

4 Visualisierungen

4.1 Parteilandschaft Schweiz

4.1.1 Multi-Dimensions-Model

4.1.1.1 Minimalwerte

Für jede Partei den Minimalwert des Abstimmungsverhaltens zu verwenden, basiert auf der Zielsetzung, die klarste politische Position einer Partei in einem bestimmten Themenbereich zu identifizieren. Diese Methodik stellt sicher, dass auch bei wenigen Abweichungen von der Mehrheitslinie die tatsächliche Haltung der Partei deutlich erkennbar bleibt.

ggplot(parties_rating,
       aes(x = eco_pct_min_x,
           y = socio_pct_min_y,
           label = Partei)) +
  geom_point(size = 3) +
  geom_text(vjust = -0.8) +
  geom_segment(aes(x = 50, xend = 50,
                   y = 0, yend = 100), linetype = "dashed", color = "blue") +
  geom_segment(aes(x = 0, xend = 100,
                   y = 50, yend = 50), linetype = "dashed", color = "blue") +
  
  annotate("text",
           x = 0,
           y = min(parties_rating$socio_pct_min_y) + 55,
           label = "Links/staatsgläubig", size = 4, hjust = 0.5) +
  annotate("text",
           x = 100,
           y = min(parties_rating$socio_pct_min_y) + 55,
           label = "Rechts/marktwirtschaftlich", size = 4, hjust = 0.5) +
  annotate("text",
           x = 50,
           y = min(parties_rating$socio_pct_min_y) - 3,
           label = "Autoritär/Konservativ", size = 4, hjust = 0.5) +
  annotate("text",
           x = 50,
           y = min(parties_rating$socio_pct_min_y) + 103,
           label = "Libertär/Progressiv", size = 4, hjust = 0.5) +
  scale_x_continuous(limits = c(0, 100)) +
  labs(x = "Wirtschaftspolitisch",
       y = "Gesellschaftspolitisch",
       title = "Politische Positionierung im Zwei-Achsen-Modell",
       subtitle = "Grundlage: Minimalwerte des Abstimmungsverhaltens") +
  theme_minimal()+
  theme(plot.title = element_text(size = 18,
                                  margin = margin(b = 30)),
        axis.title.x = element_text(size = 14,
                                    margin = margin(t = 5)),
        axis.title.y = element_text(size = 14,
                                    margin = margin(r = 5))) +
  coord_cartesian(ylim = c(0, 105),
                  xlim = c(0, 105),
                  clip = "off")

# Alle "problematischen" Zeilen (NA oder out-of-bounds)
# > Keine Inputwerte bzw. nur Durschnitte (in separater Spalte)
tmp_removed_rows <- parties_rating %>%
  filter(
    is.na(eco_pct_min_x) | is.na(socio_pct_min_y) |
    eco_pct_min_x < 0 | eco_pct_min_x > 100 |
    socio_pct_min_y < 0 | socio_pct_min_y > 100)

4.1.1.2 Durchschnittswerte als Zentrum und Min/Max als Ellipse

ggplot(parties_rating,
       aes(x = eco_pct_avg_x,
           y = socio_pct_avg_y,
           label = Partei)) +
  geom_ellipse(
    aes(x0 = eco_pct_avg_x,
        y0 = socio_pct_avg_y,
        a = (eco_pct_max_x - eco_pct_min_x) / 2, # Halbachse x
        b = (socio_pct_max_y - socio_pct_min_y) / 2, # Halbachse y
        angle = 0),
    fill = "gray80", alpha = 0.4) +
  geom_point(size = 3) +
  geom_text(vjust = -0.8) +
  geom_segment(aes(x = 50, xend = 50,
                   y = 0, yend = 100), linetype = "dashed", color = "blue") +
  geom_segment(aes(x = 0, xend = 100,
                   y = 50, yend = 50), linetype = "dashed", color = "blue") +
  annotate("text",
           x = 0,
           y = min(parties_rating$socio_pct_min_y) + 55,
           label = "Links/staatsgläubig", size = 4, hjust = 0.5) +
  annotate("text",
           x = 100,
           y = min(parties_rating$socio_pct_min_y) + 55,
           label = "Rechts/marktwirtschaftlich", size = 4, hjust = 0.5) +
  annotate("text",
           x = 50,
           y = min(parties_rating$socio_pct_min_y) - 3,
           label = "Autoritär/Konservativ", size = 4, hjust = 0.5) +
  annotate("text",
           x = 50,
           y = min(parties_rating$socio_pct_min_y) + 103,
           label = "Libertär/Progressiv", size = 4, hjust = 0.5) +
  scale_x_continuous(limits = c(-10, +110)) +
  labs(x = "Wirtschaftspolitisch",
       y = "Gesellschaftspolitisch",
       title = "Politische Positionierung im Zwei-Achsen-Modell",
       subtitle = "Grundlage: Durchschnitt des Abstimmungsverhaltens als Zentrum, Min-/Max als Ellipse") +
  theme_minimal()+
  theme(plot.title = element_text(size = 18,
                                  margin = margin(b = 30)),
        axis.title.x = element_text(size = 14,
                                    margin = margin(t = 5)),
        axis.title.y = element_text(size = 14,
                                    margin = margin(r = 5))) +
  coord_cartesian(ylim = c(0, 100),
                  xlim = c(0, 100),
                  clip = "off")

4.1.1.3 Hauptparteien: Durchschnittswerte als Zentrum und Min/Max als Ellipse / Klein- und Regionalparteien nur mit ihrem Durchschnittswert

ggplot(parties_rating,
       aes(x = eco_pct_avg_x,
           y = socio_pct_avg_y,
           label = Partei)) +
  geom_ellipse(aes(x0 = eco_pct_avg_x,
                   y0 = socio_pct_avg_y,
                   a = (eco_pct_max_x - eco_pct_min_x) / 2, # Halbachse x
                   b = (socio_pct_max_y - socio_pct_min_y) / 2, # Halbachse y
                   angle = 0),
               fill = "gray80", alpha = 0.4) +
  geom_point(size = 3) +
  
  # Kleinere Parteien
  geom_point(data = subset(parties_rating,
                           `Grosse Partei` == "n" &
                             Relevanz_nationale_Abstimmungen != "-"),
             aes(x = eco_x,
                 y = socio_y),
             shape = 21, fill = "grey", color = "black", size = 1, stroke = 1) +
  
  # Labels der kleineren Partein
  geom_text(data = subset(parties_rating,
                          `Grosse Partei` == "n" &
                            Relevanz_nationale_Abstimmungen != "-"),
            aes(x = eco_x,
                y = socio_y,
                label = Partei),
            vjust = -1, fontface = "plain", color = "darkgrey") +
  geom_text(vjust = -0.8) +
  geom_segment(aes(x = 50, xend = 50,
                   y = 0, yend = 100), linetype = "dashed", color = "blue") +
  geom_segment(aes(x = 0, xend = 100,
                   y = 50, yend = 50), linetype = "dashed", color = "blue") +
  annotate("text",
           x = 0,
           y = min(parties_rating$socio_pct_min_y) + 55,
           label = "Links/staatsgläubig", size = 4, hjust = 0.5) +
  annotate("text",
           x = 100,
           y = min(parties_rating$socio_pct_min_y) + 55,
           label = "Rechts/marktwirtschaftlich", size = 4, hjust = 0.5) +
  annotate("text",
           x = 50,
           y = min(parties_rating$socio_pct_min_y) - 3,
           label = "Autoritär/Konservativ", size = 4, hjust = 0.5) +
  annotate("text",
           x = 50,
           y = min(parties_rating$socio_pct_min_y) + 103,
           label = "Libertär/Progressiv", size = 4, hjust = 0.5) +
  scale_x_continuous(limits = c(-10, +110)) +
  labs(x = "Wirtschaftspolitisch",
       y = "Gesellschaftspolitisch",
       title = "Politische Positionierung im Zwei-Achsen-Modell",
       subtitle = "Durchschnitt des Abstimmungsverhaltens als Zentrum, Min-/Max als Ellipse") +
  theme_minimal()+
  theme(plot.title = element_text(size = 18,
                                  margin = margin(b = 30)),
        axis.title.x = element_text(size = 14,
                                    margin = margin(t = 5)),
        axis.title.y = element_text(size = 14,
                                    margin = margin(r = 5))) +
  coord_cartesian(ylim = c(0, 100),
                  xlim = c(0, 100),
                  clip = "off")

4.1.2 3D-Koordinatensystem

parties_rating_3d <- parties_rating_3d %>% 
  mutate("Wirtschaft" = eco_pct_min_x,
         "Gesellschaft" = socio_pct_min_x,
         "Umwelt" = oeco_pct_min_x) %>%
  select(-eco_pct_min_x, -socio_pct_min_x, -oeco_pct_min_x)



# Interaktives 3D-Scatterplot mit Plotly
# Achsen benennen und formatieren
fig <- plot_ly(data = parties_rating_3d,
               x = ~Wirtschaft,             # 100% = liberale Wirtschaftspolitik
                                            #   0% = Interventionistisch
               y = ~Gesellschaft,           # 100% = liberale Gesellschaftspolitik
                                            #   0% = restriktive/konservativ
               z = ~Umwelt,                 # 100% = ausgebauter Umweltschutz
                                            #   0% = schwacher Umweltschutz
               text = ~Partei,
               type = 'scatter3d',
               mode = 'markers+text',
               marker = list(size = 6, color = "darkblue", opacity = 0.8),
               textposition = 'top center') %>%
  layout(title = list(text = "Schweizer Parteilandschaft im 3D-Modell",
                      font = list(size = 18)),
         scene = list(xaxis = list(title = "Wirtschaft (staatlich-liberal)",
                                   range = c(0, 100)),
                      yaxis = list(title = "Gesellschaft (konservativ-liberal)",
                                   range = c(0, 100)),
                      zaxis = list(title = "Umwelt (schwach-stark)",
                                   range = c(0, 100))
                      # camera = list(eye = list(x = 1.5,
                      #                          y = 1.5,
                      #                          z = 1.2))
                      ),
         margin = list(l = 0, r = 0, b = 0, t = 40),
         paper_bgcolor = 'white',
         plot_bgcolor = 'white')

# Plot anzeigen
fig

4.1.2.1 Tables Parties Rating

# Funktion für identische Formatierung
format_table <- function(df) {
  # df[[1]] <- as.character(df[[1]])
  # df[[3]] <- as.character(df[[3]])
  ft <- flextable(df)
  ft <- theme_vanilla(ft)
  ft <- font(ft, fontname = "Courier New", part = "all")
  ft <- fontsize(ft, size = 8, part = "all")
  ft <- colformat_double(ft, digits = 2)
  #ft <- colformat_double(ft, digits = 1, suffix = "%")
  ft <- width(ft, j = 2, width = 2)
  return(ft)
}

# Tabelle 1: Parties Rating
df1 <- head(parties_rating, 8)
ft1 <- format_table(df1)

# # Tabelle 2: ABGELEHNT
# df2 <- head(parties_rating)
# ft2 <- format_table(df2)


# Word-Dokument erstellen und beide Tabellen einfügen ---
doc <- read_docx()
doc <- body_add_par(doc,
                    "Rating der Parteien",
                    style = "heading 1")
doc <- body_add_flextable(doc,
                          ft1)
# doc <- body_add_par(doc, "") # Leerzeile
# doc <- body_add_par(doc,
#                     "Ablehnung trotz fehlender Unterstützung durch Parolen",
#                     style = "heading 1")
# doc <- body_add_flextable(doc,
#                           ft2)


# Speichern 
print(doc, target = "result/Parties_Rating.docx")

print(parties_rating)

# A tibble: 46 × 16
   Partei Partei_lang       `Grosse Partei` Relevanz_nationale_A…¹ eco_pct_min_x
   <chr>  <chr>             <chr>           <chr>                          <dbl>
 1 EVP    Evangelische Vol… y               Mittel                          24.5
 2 FDP    Freisinnig-demok… y               Sehr hoch                       74  
 3 GLP    Grünliberale Par… y               Mittel bis hoch                 50  
 4 GPS    Grüne             y               Hoch                            10.6
 5 Mitte  Die Mitte         y               Sehr hoch                       44.9
 6 SPS    SP                y               Sehr hoch                        0  
 7 SVP    Schweizerische V… y               Sehr hoch                       54.3
 8 UCSP   Christlichsozial… n               -                               NA  
 9 PDA    Partei der Arbeit n               Klein                           NA  
10 SD     Schweizer Demokr… n               Klein                           NA  
# ℹ 36 more rows
# ℹ abbreviated name: ¹​Relevanz_nationale_Abstimmungen
# ℹ 11 more variables: eco_pct_avg_x <dbl>, eco_pct_max_x <dbl>,
#   socio_pct_min_y <dbl>, socio_pct_avg_y <dbl>, socio_pct_max_y <dbl>,
#   Positionierung <chr>, eco_x <dbl>, socio_y <dbl>, Kommentar <chr>,
#   Quelle1 <chr>, Quelle2 <chr>

4.1.3 Zwei-Achsen-Modell je statistischer Stadt auf der Landkarte

ACHTUNG: Vergleichsweise “Rechen- und Speicherplatzintensiv”

# Datensätze ("Parteien/Mandate & Position in Parteilandschaft) zusammenführen
elec_joined <- elec_gemeinde_lvl_gemeinde %>%
  left_join(parties_rating %>% select(Partei,
                                      eco_x,
                                      socio_y),
            by = c("Partei" = "Partei"))

# Punkt im Koordinatensysem - Gewichtung nach Parteistärke je Gemeinde
elec_joined_weighted <- elec_joined %>%
  mutate(eco_weighted = n_seats_pct * eco_x,
         socio_weighted = n_seats_pct * socio_y) %>%
  group_by(year, Gemeinde) %>%
  summarise(eco = sum(eco_weighted, na.rm = TRUE) / sum(n_seats_pct,
                                                        na.rm = TRUE),
            socio = sum(socio_weighted, na.rm = TRUE) / sum(n_seats_pct,
                                                            na.rm = TRUE)) %>%
  ungroup()

# Koordinaten hinzufügen
# Gemeindeschreibweisen ggfs. korrigieren.
elec_joined_weighted_with_coords <- elec_joined_weighted %>%
  mutate(Gemeinde = case_when(
      Gemeinde == "Aesch (BL)"        ~ "Aesch BL",
      Gemeinde == "Altdorf (UR)"      ~ "Altdorf UR",
      Gemeinde == "Altstätten"        ~ "Altstätten SG",
      Gemeinde == "Brig-Glis"         ~ "Brig",
      Gemeinde == "Brugg"             ~ "Brugg AG",
      Gemeinde == "Buchs (SG)"        ~ "Buchs SG",
      Gemeinde == "Carouge (GE)"      ~ "Carouge GE",
      Gemeinde == "Davos"             ~ "Davos Dorf",
      Gemeinde == "Ecublens (VD)"     ~ "Ecublens VD",
      Gemeinde == "Glarus Nord"       ~ "Glarus",
      Gemeinde == "Gossau (SG)"       ~ "Gossau SG",
      Gemeinde == "Illnau-Effretikon" ~ "Illnau",
      Gemeinde == "Küsnacht (ZH)"     ~ "Küsnacht ZH",
      Gemeinde == "Lancy"             ~ "Grand-Lancy",
      Gemeinde == "Muri bei Bern"     ~ "Muri b. Bern",
      Gemeinde == "Oberwil (BL)"      ~ "Oberwil BL",
      Gemeinde == "Pfäffikon"         ~ "Pfäffikon SZ",
      Gemeinde == "Rapperswil-Jona"   ~ "Rapperswil SG",
      Gemeinde == "Reinach (BL)"      ~ "Reinach BL",
      Gemeinde == "Renens (VD)"       ~ "Renens VD",
      Gemeinde == "Rüti (ZH)"         ~ "Rüti ZH",
      Gemeinde == "Wetzikon (ZH)"     ~ "Wetzikon ZH",
      Gemeinde == "Wil (SG)"          ~ "Wil SG",
      Gemeinde == "Wohlen (AG)"       ~ "Wohlen AG",
      Gemeinde == "Lachen"            ~ "Lachen SZ",
      TRUE                            ~ Gemeinde)) %>% 
  left_join(ortschaftenverzeichnis %>%
              select(Ortschaftsname, E, N),
            by = c("Gemeinde" = "Ortschaftsname"),
            relationship = "many-to-many") %>%
  group_by(year, Gemeinde, eco, socio) %>%
  summarise(E = mean(E, na.rm = TRUE),
            N = mean(N, na.rm = TRUE),
            .groups = "drop")

print(elec_joined_weighted_with_coords)

# A tibble: 1,144 × 6
    year Gemeinde             eco socio     E     N
   <int> <chr>              <dbl> <dbl> <dbl> <dbl>
 1  2019 Aarau               33.4  24.3  8.06  47.4
 2  2019 Adliswil            43.6  25.7  8.52  47.3
 3  2019 Aesch BL            56    33.6  7.57  47.5
 4  2019 Affoltern am Albis  31.7  19    8.45  47.3
 5  2019 Aigle               52.2  33    6.97  46.3
 6  2019 Allschwil           42    32.9  7.53  47.5
 7  2019 Altdorf UR          50.6  41.4  8.65  46.9
 8  2019 Altstätten SG       43.6  25.7  9.52  47.4
 9  2019 Amriswil            60.6  22.8  9.31  47.5
10  2019 Arbon               41.4  35    9.43  47.5
# ℹ 1,134 more rows

gemeinden_ohne_coords_df <- elec_joined_weighted_with_coords %>%
  filter(is.na(E) | is.na(N)) %>%
  distinct(Gemeinde) %>% 
  print(n=Inf)

# A tibble: 0 × 1
# ℹ 1 variable: Gemeinde <chr>

print(gemeinden_ohne_coords_df)

# A tibble: 0 × 1
# ℹ 1 variable: Gemeinde <chr>

#################################################################
# Das ergzeugen von PNG Dateien ist ein nötig, weil jeden Punkt #
# der Leaflet-Karte ein individuelles Minidiagramm (Miniplot)   #
# als Marker angezeigt bekommen soll. Leaflet kann aber keine   #
# ggplot2-Objekte oder R-Plots direkt als Marker darstellen,    #
# sonder akzeptiert nur Bilddateien als Icons für Marker.       #
#################################################################

#################################################################
# Miniplots nur bei Bedarf neu erzeugen                         #
# e.g. Aufgrund Änderung der Datengrundlage/Formatierung        #
# TRUE = neu erzeugen, FALSE = vorhandene PNGs verwenden        #
#################################################################

generate_miniplots <- FALSE                          



# Daten vorbereiten
map_data <- elec_joined_weighted_with_coords %>%
  filter(!is.na(E), !is.na(N))
  #        Gemeinde %in% c("Winterthur", "Zürich"))

# Hilfsfunktion für Dateinamen (keine Sonderzeichen)
safe_name <- function(x) gsub("[^A-Za-z0-9]", "_", x)

# Farbpalette für Leaflet-Legende vorbereiten
all_years <- sort(unique(elec_joined_weighted_with_coords$year))
min_year <- min(all_years)
max_year <- max(all_years)
pal <- colorNumeric(palette = colorRampPalette(c("grey80", "navy"))(256),
                    domain = c(min_year,
                               max_year))

# Mini-Plots als PNG erzeugen (mit halbtransparenter weißer Fläche)
if (generate_miniplots) {
  dir.create("mini_plots", showWarnings = FALSE)
  
  pb <- txtProgressBar(min = 0,
                       max = nrow(map_data),
                       style = 3)
  
  for (i in seq_len(nrow(map_data))) {
    # Alle Jahre für diese Gemeinde auswählen
    df_gemeinde <- elec_joined_weighted_with_coords %>%
      filter(Gemeinde == map_data$Gemeinde[i],
             !is.na(eco),
             !is.na(socio),
             !is.na(year))

    g <- ggplot(df_gemeinde,
                aes(x = eco, y = socio, color = year)) +
      geom_point(size = 12) +
      geom_vline(xintercept = 50, linetype = "dashed", color = "blue", size = 2) +
      geom_hline(yintercept = 50, linetype = "dashed", color = "blue", size = 2) +
      scale_x_continuous(limits = c(0, 100), expand = c(0,5),
                         labels = function(x) paste0(x, "%")) +
      scale_y_continuous(limits = c(0, 100), expand = c(0,5),
                         labels = function(x) paste0(x, "%")) +
      scale_color_gradient(low = "grey80", high = "navy",
                           name = "Jahr",
                           limits = c(min_year, max_year)) +
      labs(x = "Wirtschaftspolitisch",
           y = "Gesellschaftspolitisch") +
      theme_minimal(base_size = 28) +
      theme(
        panel.background = element_rect(fill = rgb(1, 1, 1, 0.1),
                                        color = NA),  # 10 % transparent weiss
        plot.background = element_rect(fill = "transparent",
                                       color = NA),
        axis.title = element_text(size = 40),
        axis.text = element_text(size = 28),
        axis.line = element_line(size = 2),
        legend.position = "none",                      # Legende AUS
        panel.grid = element_blank(),
        plot.margin = margin(8, 8, 8, 8, "pt"))
    
    ggsave(filename = sprintf("mini_plots/%s.png",
                              safe_name(map_data$Gemeinde[i])),
           plot = g,
           width = 9, height = 9,
           units = "in", bg = "transparent", dpi = 150)
    setTxtProgressBar(pb, i)}
  close(pb)}

# Icons für Leaflet erstellen (benannte Liste von makeIcon-Objekten)
icon_names <- safe_name(map_data$Gemeinde)
icon_paths <- sprintf("mini_plots/%s.png", icon_names)
icon_list <- setNames(
  lapply(icon_paths, function(path) makeIcon(iconUrl = path,
                                             iconWidth = 240,
                                             iconHeight = 240)),
  icon_names)
icon_set <- do.call(iconList, icon_list)
map_data$icon_name <- icon_names

# Karte mit individuellen Mini-Plot-Icons und Legende anzeigen
leaflet(map_data) %>%
  addTiles() %>%
  # Fokus auf HWZ Zürich :-)
  setView(lng = 8.5328, lat = 47.3781, zoom = 13) %>%
  # setView(lng = mean(map_data$E), lat = mean(map_data$N), zoom = 8) %>%
  addMarkers(lng = ~E,
             lat = ~N,
             icon = ~icon_set[icon_name],
             label = ~Gemeinde) %>%
  addLegend(position = "bottomright",
            pal = pal,
            values = c(min_year, max_year),
            title = "Jahr",
            labFormat = labelFormat(big.mark = "",
                                    transform = function(x) as.integer(x)),
            opacity = 1)

4.2 Abstimmungen

4.2.1 Daten

voting_5y_plot_data <- voting_5y_long %>% 
  select(datum,
         titel_kurz_d,
         rechtsform,
         annahme)

split_list <- voting_5y_plot_data %>%
  group_by(rechtsform) %>%
  group_split()      

voting_obli_referendum <- split_list[[1]]
voting_faku_referendum <- split_list[[2]]
voting_volksinitiative <- split_list[[3]]

# Heatmap erstellen
plot_data <- voting_5y_plot_data %>%
  mutate(annahme = factor(annahme, levels = c("0", "1"), labels = c("Nein", "Ja")))

# Heatmap
ggplot(plot_data,
       aes(x = annahme,
           y = titel_kurz_d,
           fill = annahme)) +
  geom_tile(color = "white") +
  scale_fill_manual(values = c("Nein" = "red", "Ja" = "green")) +
  labs(
    title = "Abstimmungsergebnisse",
    x = "Ergebnis",
    y = "Vorlage",
    fill = "Annahme"  ) +
  theme_minimal() +
  theme(axis.text.y = element_text(size = 8))

plot_data <- voting_5y_plot_data %>%
  mutate(annahme = factor(annahme, levels = c("0","1"), labels = c("Nein", "Ja")))

levels(plot_data$annahme)

[1] "Nein" "Ja"  

ggplot(plot_data,
       aes(x = annahme,
           y = titel_kurz_d,
           fill = annahme)) +
  geom_tile(color = "white") +
  scale_fill_manual(values = c("Nein" = "red", "Ja" = "green")) +
  labs(
    title = "Abstimmungsergebnisse nach Rechtsform",
    x = "Ergebnis",
    y = "Vorlage",
    fill = "Annahme"
  ) +
  theme_minimal() +
  theme(axis.text.y = element_text(size = 8)) +
  facet_wrap(~ rechtsform, scales = "free_y")

4.2.2 Tatsächliches Ergebnis und Verteilung der Parolen (Ja-Nein-Keine) pro Jahr

voting_5y_final %>% 
  group_by(year) %>% 
  summarise(anzahl_anr = n_distinct(anr))

# A tibble: 7 × 2
   year anzahl_anr
  <dbl>      <int>
1  2019          3
2  2020          9
3  2021         13
4  2022         11
5  2023          3
6  2024         12
7  2025          1

#    year anzahl_anr
#   <dbl>      <int>    pixel height (200+50 je Zeile)
# 1  2019          3    350
# 2  2020          9    650
# 3  2021         13    850
# 4  2022         11    750
# 5  2023          3    350
# 6  2024         12    800
# 7  2025          1    250


voting_5y_final_reduced_data_table <- voting_5y_final %>%
  select(anr, annahme, year, titel_kurz_d, contains("_parole_"))

##DATUMSFILTER##
jahr <- 2025

# Daten für den Balkenplot vorbereiten (alle parole-Spalten, Quelle extrahieren)
df_plot <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, matches("^(state|kt|gemeinde)_parole_")) %>%
  pivot_longer(cols = matches("^(state|kt|gemeinde)_parole_"),
               names_to = "parole_typ",
               values_to = "wert") %>%
  mutate(
    parole_quelle = case_when(
      grepl("^state_parole_", parole_typ) ~ "National- & Ständerat",
      grepl("^kt_parole_", parole_typ) ~ "Kantonsregierung*",
      grepl("^gemeinde_parole_", parole_typ) ~ "Gemeinde*"),
    parole_typ = case_when(
      grepl("_Nein$", parole_typ) ~ "Nein",
      grepl("_Ja$", parole_typ) ~ "Ja",
      grepl("_Keine$", parole_typ) ~ "Keine"),
    anr = factor(anr, levels = unique(anr)),
    parole_quelle = factor(parole_quelle, levels = c("National- & Ständerat",
                                                     "Kantonsregierung*",
                                                     "Gemeinde*")))

# Annahme-Daten für die Punkte vorbereiten
df_annahme <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, annahme) %>%
  mutate(
    anr = factor(anr, levels = unique(df_plot$anr)),
    annahme = as.numeric(annahme) # Annahme: 0 oder 1
  )

# Plot mit Balken und Annahme-Punkt, getrennt nach parole_quelle
ggplot() +
  geom_bar(data = df_plot,
           mapping = aes(x = anr,
                         y = wert,
                         fill = parole_typ),
           stat = "identity",
           position = "fill",
           width = 1) +
  geom_point(data = df_annahme,
             mapping = aes(x = anr,
                           y = annahme,
                           shape = "Abstimmungsergebnis"),
             color = "black", size = 3) +
  scale_shape_manual(name = "",
                     values = c("Abstimmungsergebnis" = 16)) +
  scale_y_continuous(labels = scales::percent_format()) +
  coord_flip() +
  facet_wrap(~ parole_quelle, ncol = 1, scales = "free_y") +
  labs(x = "Abstimmung (anr)",
       y = "Anteil",
       fill = "Parole",
       title = paste("Verteilung Ja/Nein/Keine pro Abstimmung –",
                     jahr),
       subtitle = paste("* aggregiert, gewichtet nach Stimmberechtigten/Einwohner"),
       caption = paste("Quelle: Dataframe ''voting_5y_final''")) +
  geom_hline(yintercept = 0.5,
             linetype = "dashed", color = "black") +
  theme_minimal() +
  scale_fill_manual(values = c("Ja" = "#66A61E",
                               "Keine" = "#BDBDBD",
                               "Nein" = "#D95F02")) +
  guides(
    fill = guide_legend(order = 1),
    shape = guide_legend(order = 2)  )

##DATUMSFILTER##
jahr <- 2024

# Daten für den Balkenplot vorbereiten (alle parole-Spalten, Quelle extrahieren)
df_plot <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, matches("^(state|kt|gemeinde)_parole_")) %>%
  pivot_longer(cols = matches("^(state|kt|gemeinde)_parole_"),
               names_to = "parole_typ",
               values_to = "wert") %>%
  mutate(
    parole_quelle = case_when(
      grepl("^state_parole_", parole_typ) ~ "National- & Ständerat",
      grepl("^kt_parole_", parole_typ) ~ "Kantonsregierung*",
      grepl("^gemeinde_parole_", parole_typ) ~ "Gemeinde*"),
    parole_typ = case_when(
      grepl("_Nein$", parole_typ) ~ "Nein",
      grepl("_Ja$", parole_typ) ~ "Ja",
      grepl("_Keine$", parole_typ) ~ "Keine"),
    anr = factor(anr, levels = unique(anr)),
    parole_quelle = factor(parole_quelle, levels = c("National- & Ständerat",
                                                     "Kantonsregierung*",
                                                     "Gemeinde*")))

# Annahme-Daten für die Punkte vorbereiten
df_annahme <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, annahme) %>%
  mutate(
    anr = factor(anr, levels = unique(df_plot$anr)),
    annahme = as.numeric(annahme) # Annahme: 0 oder 1
  )

# Plot mit Balken und Annahme-Punkt, getrennt nach parole_quelle
ggplot() +
  geom_bar(data = df_plot,
           mapping = aes(x = anr,
                         y = wert,
                         fill = parole_typ),
           stat = "identity",
           position = "fill",
           width = 1) +
  geom_point(data = df_annahme,
             mapping = aes(x = anr,
                           y = annahme,
                           shape = "Abstimmungsergebnis"),
             color = "black", size = 3) +
  scale_shape_manual(name = "",
                     values = c("Abstimmungsergebnis" = 16)) +
  scale_y_continuous(labels = scales::percent_format()) +
  coord_flip() +
  facet_wrap(~ parole_quelle, ncol = 1, scales = "free_y") +
  labs(x = "Abstimmung (anr)",
       y = "Anteil",
       fill = "Parole",
       title = paste("Verteilung Ja/Nein/Keine pro Abstimmung –",
                     jahr),
       subtitle = paste("* aggregiert, gewichtet nach Stimmberechtigten/Einwohner"),
       caption = paste("Quelle: Dataframe ''voting_5y_final''")) +
  geom_hline(yintercept = 0.5,
             linetype = "dashed", color = "black") +
  theme_minimal() +
  scale_fill_manual(values = c("Ja" = "#66A61E",
                               "Keine" = "#BDBDBD",
                               "Nein" = "#D95F02")) +
  guides(
    fill = guide_legend(order = 1),
    shape = guide_legend(order = 2)  )

##DATUMSFILTER##
jahr <- 2023

# Daten für den Balkenplot vorbereiten (alle parole-Spalten, Quelle extrahieren)
df_plot <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, matches("^(state|kt|gemeinde)_parole_")) %>%
  pivot_longer(cols = matches("^(state|kt|gemeinde)_parole_"),
               names_to = "parole_typ",
               values_to = "wert") %>%
  mutate(
    parole_quelle = case_when(
      grepl("^state_parole_", parole_typ) ~ "National- & Ständerat",
      grepl("^kt_parole_", parole_typ) ~ "Kantonsregierung*",
      grepl("^gemeinde_parole_", parole_typ) ~ "Gemeinde*"),
    parole_typ = case_when(
      grepl("_Nein$", parole_typ) ~ "Nein",
      grepl("_Ja$", parole_typ) ~ "Ja",
      grepl("_Keine$", parole_typ) ~ "Keine"),
    anr = factor(anr, levels = unique(anr)),
    parole_quelle = factor(parole_quelle, levels = c("National- & Ständerat",
                                                     "Kantonsregierung*",
                                                     "Gemeinde*")))

# Annahme-Daten für die Punkte vorbereiten
df_annahme <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, annahme) %>%
  mutate(
    anr = factor(anr, levels = unique(df_plot$anr)),
    annahme = as.numeric(annahme) # Annahme: 0 oder 1
  )

# Plot mit Balken und Annahme-Punkt, getrennt nach parole_quelle
ggplot() +
  geom_bar(data = df_plot,
           mapping = aes(x = anr,
                         y = wert,
                         fill = parole_typ),
           stat = "identity",
           position = "fill",
           width = 1) +
  geom_point(data = df_annahme,
             mapping = aes(x = anr,
                           y = annahme,
                           shape = "Abstimmungsergebnis"),
             color = "black", size = 3) +
  scale_shape_manual(name = "",
                     values = c("Abstimmungsergebnis" = 16)) +
  scale_y_continuous(labels = scales::percent_format()) +
  coord_flip() +
  facet_wrap(~ parole_quelle, ncol = 1, scales = "free_y") +
  labs(x = "Abstimmung (anr)",
       y = "Anteil",
       fill = "Parole",
       title = paste("Verteilung Ja/Nein/Keine pro Abstimmung –",
                     jahr),
       subtitle = paste("* aggregiert, gewichtet nach Stimmberechtigten/Einwohner"),
       caption = paste("Quelle: Dataframe ''voting_5y_final''")) +
  geom_hline(yintercept = 0.5,
             linetype = "dashed", color = "black") +
  theme_minimal() +
  scale_fill_manual(values = c("Ja" = "#66A61E",
                               "Keine" = "#BDBDBD",
                               "Nein" = "#D95F02")) +
  guides(
    fill = guide_legend(order = 1),
    shape = guide_legend(order = 2)  )

##DATUMSFILTER##
jahr <- 2022

# Daten für den Balkenplot vorbereiten (alle parole-Spalten, Quelle extrahieren)
df_plot <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, matches("^(state|kt|gemeinde)_parole_")) %>%
  pivot_longer(cols = matches("^(state|kt|gemeinde)_parole_"),
               names_to = "parole_typ",
               values_to = "wert") %>%
  mutate(
    parole_quelle = case_when(
      grepl("^state_parole_", parole_typ) ~ "National- & Ständerat",
      grepl("^kt_parole_", parole_typ) ~ "Kantonsregierung*",
      grepl("^gemeinde_parole_", parole_typ) ~ "Gemeinde*"),
    parole_typ = case_when(
      grepl("_Nein$", parole_typ) ~ "Nein",
      grepl("_Ja$", parole_typ) ~ "Ja",
      grepl("_Keine$", parole_typ) ~ "Keine"),
    anr = factor(anr, levels = unique(anr)),
    parole_quelle = factor(parole_quelle, levels = c("National- & Ständerat",
                                                     "Kantonsregierung*",
                                                     "Gemeinde*")))

# Annahme-Daten für die Punkte vorbereiten
df_annahme <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, annahme) %>%
  mutate(
    anr = factor(anr, levels = unique(df_plot$anr)),
    annahme = as.numeric(annahme) # Annahme: 0 oder 1
  )

# Plot mit Balken und Annahme-Punkt, getrennt nach parole_quelle
ggplot() +
  geom_bar(data = df_plot,
           mapping = aes(x = anr,
                         y = wert,
                         fill = parole_typ),
           stat = "identity",
           position = "fill",
           width = 1) +
  geom_point(data = df_annahme,
             mapping = aes(x = anr,
                           y = annahme,
                           shape = "Abstimmungsergebnis"),
             color = "black", size = 3) +
  scale_shape_manual(name = "",
                     values = c("Abstimmungsergebnis" = 16)) +
  scale_y_continuous(labels = scales::percent_format()) +
  coord_flip() +
  facet_wrap(~ parole_quelle, ncol = 1, scales = "free_y") +
  labs(x = "Abstimmung (anr)",
       y = "Anteil",
       fill = "Parole",
       title = paste("Verteilung Ja/Nein/Keine pro Abstimmung –",
                     jahr),
       subtitle = paste("* aggregiert, gewichtet nach Stimmberechtigten/Einwohner"),
       caption = paste("Quelle: Dataframe ''voting_5y_final''")) +
  geom_hline(yintercept = 0.5,
             linetype = "dashed", color = "black") +
  theme_minimal() +
  scale_fill_manual(values = c("Ja" = "#66A61E",
                               "Keine" = "#BDBDBD",
                               "Nein" = "#D95F02")) +
  guides(
    fill = guide_legend(order = 1),
    shape = guide_legend(order = 2)  )

##DATUMSFILTER##
jahr <- 2021

# Daten für den Balkenplot vorbereiten (alle parole-Spalten, Quelle extrahieren)
df_plot <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, matches("^(state|kt|gemeinde)_parole_")) %>%
  pivot_longer(cols = matches("^(state|kt|gemeinde)_parole_"),
               names_to = "parole_typ",
               values_to = "wert") %>%
  mutate(
    parole_quelle = case_when(
      grepl("^state_parole_", parole_typ) ~ "National- & Ständerat",
      grepl("^kt_parole_", parole_typ) ~ "Kantonsregierung*",
      grepl("^gemeinde_parole_", parole_typ) ~ "Gemeinde*"),
    parole_typ = case_when(
      grepl("_Nein$", parole_typ) ~ "Nein",
      grepl("_Ja$", parole_typ) ~ "Ja",
      grepl("_Keine$", parole_typ) ~ "Keine"),
    anr = factor(anr, levels = unique(anr)),
    parole_quelle = factor(parole_quelle, levels = c("National- & Ständerat",
                                                     "Kantonsregierung*",
                                                     "Gemeinde*")))

# Annahme-Daten für die Punkte vorbereiten
df_annahme <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, annahme) %>%
  mutate(
    anr = factor(anr, levels = unique(df_plot$anr)),
    annahme = as.numeric(annahme) # Annahme: 0 oder 1
  )

# Plot mit Balken und Annahme-Punkt, getrennt nach parole_quelle
ggplot() +
  geom_bar(data = df_plot,
           mapping = aes(x = anr,
                         y = wert,
                         fill = parole_typ),
           stat = "identity",
           position = "fill",
           width = 1) +
  geom_point(data = df_annahme,
             mapping = aes(x = anr,
                           y = annahme,
                           shape = "Abstimmungsergebnis"),
             color = "black", size = 3) +
  scale_shape_manual(name = "",
                     values = c("Abstimmungsergebnis" = 16)) +
  scale_y_continuous(labels = scales::percent_format()) +
  coord_flip() +
  facet_wrap(~ parole_quelle, ncol = 1, scales = "free_y") +
  labs(x = "Abstimmung (anr)",
       y = "Anteil",
       fill = "Parole",
       title = paste("Verteilung Ja/Nein/Keine pro Abstimmung –",
                     jahr),
       subtitle = paste("* aggregiert, gewichtet nach Stimmberechtigten/Einwohner"),
       caption = paste("Quelle: Dataframe ''voting_5y_final''")) +
  geom_hline(yintercept = 0.5,
             linetype = "dashed", color = "black") +
  theme_minimal() +
  scale_fill_manual(values = c("Ja" = "#66A61E",
                               "Keine" = "#BDBDBD",
                               "Nein" = "#D95F02")) +
  guides(
    fill = guide_legend(order = 1),
    shape = guide_legend(order = 2)  )

##DATUMSFILTER##
jahr <- 2020

# Daten für den Balkenplot vorbereiten (alle parole-Spalten, Quelle extrahieren)
df_plot <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, matches("^(state|kt|gemeinde)_parole_")) %>%
  pivot_longer(cols = matches("^(state|kt|gemeinde)_parole_"),
               names_to = "parole_typ",
               values_to = "wert") %>%
  mutate(
    parole_quelle = case_when(
      grepl("^state_parole_", parole_typ) ~ "National- & Ständerat",
      grepl("^kt_parole_", parole_typ) ~ "Kantonsregierung*",
      grepl("^gemeinde_parole_", parole_typ) ~ "Gemeinde*"),
    parole_typ = case_when(
      grepl("_Nein$", parole_typ) ~ "Nein",
      grepl("_Ja$", parole_typ) ~ "Ja",
      grepl("_Keine$", parole_typ) ~ "Keine"),
    anr = factor(anr, levels = unique(anr)),
    parole_quelle = factor(parole_quelle, levels = c("National- & Ständerat",
                                                     "Kantonsregierung*",
                                                     "Gemeinde*")))

# Annahme-Daten für die Punkte vorbereiten
df_annahme <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, annahme) %>%
  mutate(
    anr = factor(anr, levels = unique(df_plot$anr)),
    annahme = as.numeric(annahme) # Annahme: 0 oder 1
  )

# Plot mit Balken und Annahme-Punkt, getrennt nach parole_quelle
ggplot() +
  geom_bar(data = df_plot,
           mapping = aes(x = anr,
                         y = wert,
                         fill = parole_typ),
           stat = "identity",
           position = "fill",
           width = 1) +
  geom_point(data = df_annahme,
             mapping = aes(x = anr,
                           y = annahme,
                           shape = "Abstimmungsergebnis"),
             color = "black", size = 3) +
  scale_shape_manual(name = "",
                     values = c("Abstimmungsergebnis" = 16)) +
  scale_y_continuous(labels = scales::percent_format()) +
  coord_flip() +
  facet_wrap(~ parole_quelle, ncol = 1, scales = "free_y") +
  labs(x = "Abstimmung (anr)",
       y = "Anteil",
       fill = "Parole",
       title = paste("Verteilung Ja/Nein/Keine pro Abstimmung –",
                     jahr),
       subtitle = paste("* aggregiert, gewichtet nach Stimmberechtigten/Einwohner"),
       caption = paste("Quelle: Dataframe ''voting_5y_final''")) +
  geom_hline(yintercept = 0.5,
             linetype = "dashed", color = "black") +
  theme_minimal() +
  scale_fill_manual(values = c("Ja" = "#66A61E",
                               "Keine" = "#BDBDBD",
                               "Nein" = "#D95F02")) +
  guides(
    fill = guide_legend(order = 1),
    shape = guide_legend(order = 2)  )

##DATUMSFILTER##
jahr <- 2019

# Daten für den Balkenplot vorbereiten (alle parole-Spalten, Quelle extrahieren)
df_plot <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, matches("^(state|kt|gemeinde)_parole_")) %>%
  pivot_longer(cols = matches("^(state|kt|gemeinde)_parole_"),
               names_to = "parole_typ",
               values_to = "wert") %>%
  mutate(
    parole_quelle = case_when(
      grepl("^state_parole_", parole_typ) ~ "National- & Ständerat",
      grepl("^kt_parole_", parole_typ) ~ "Kantonsregierung*",
      grepl("^gemeinde_parole_", parole_typ) ~ "Gemeinde*"),
    parole_typ = case_when(
      grepl("_Nein$", parole_typ) ~ "Nein",
      grepl("_Ja$", parole_typ) ~ "Ja",
      grepl("_Keine$", parole_typ) ~ "Keine"),
    anr = factor(anr, levels = unique(anr)),
    parole_quelle = factor(parole_quelle, levels = c("National- & Ständerat",
                                                     "Kantonsregierung*",
                                                     "Gemeinde*")))

# Annahme-Daten für die Punkte vorbereiten
df_annahme <- voting_5y_final %>%
  filter(year == jahr) %>%
  select(anr, annahme) %>%
  mutate(
    anr = factor(anr, levels = unique(df_plot$anr)),
    annahme = as.numeric(annahme) # Annahme: 0 oder 1
  )

# Plot mit Balken und Annahme-Punkt, getrennt nach parole_quelle
ggplot() +
  geom_bar(data = df_plot,
           mapping = aes(x = anr,
                         y = wert,
                         fill = parole_typ),
           stat = "identity",
           position = "fill",
           width = 1) +
  geom_point(data = df_annahme,
             mapping = aes(x = anr,
                           y = annahme,
                           shape = "Abstimmungsergebnis"),
             color = "black", size = 3) +
  scale_shape_manual(name = "",
                     values = c("Abstimmungsergebnis" = 16)) +
  scale_y_continuous(labels = scales::percent_format()) +
  coord_flip() +
  facet_wrap(~ parole_quelle, ncol = 1, scales = "free_y") +
  labs(x = "Abstimmung (anr)",
       y = "Anteil",
       fill = "Parole",
       title = paste("Verteilung Ja/Nein/Keine pro Abstimmung –",
                     jahr),
       subtitle = paste("* aggregiert, gewichtet nach Stimmberechtigten/Einwohner"),
       caption = paste("Quelle: Dataframe ''voting_5y_final''")) +
  geom_hline(yintercept = 0.5,
             linetype = "dashed", color = "black") +
  theme_minimal() +
  scale_fill_manual(values = c("Ja" = "#66A61E",
                               "Keine" = "#BDBDBD",
                               "Nein" = "#D95F02")) +
  guides(
    fill = guide_legend(order = 1),
    shape = guide_legend(order = 2)  )